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BASSSARITH 16-Sep-1984 01:10:24 AX-11 Bliss-32 V4.0-74 Pp 1 E 
| 12-808 - 1 3b 1:48: 9 YBASRTL SRe BASSARITH.832;1 we tt 1 
1 © MODULE BASSSARITH ( ! BASIC String Arithmeti 
09¢ LDENT = "1-024" ' File: BASSARITH.B32Edit: MDL 1024 
006 BEGIN 
0 i eeeeeeeeeeererereeeeereeeeeetereteeeeerereeeeereeeeeeeeneeeeeeeeereeeeeenet 


IS 


!# COPYRIGHT (c) 1978 


a3 


1980, 1982, 1984 BY 
ie DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS. 
tt ALL RIGHTS RESERVED. 


'® THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED 
ONLY IN Me WITH THE TERMS OF te of tGhne” AND WITH THE 


OoOooooooooooo 


Oooo 


't TRANSFERRED. 


:# THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE 
CORPORAT bn NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT 


ts DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS 
:® SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. 


1 
1 * 
1 * 
4 % 
1 © 
1 a 
1 © 
1 * 
1 Ye 
: e 
; 0 e 
ie OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY * 
© 
1 * 
1 © 
1 * 
1 e 
1 e 
1 * 
1 ® 
! & 
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++ 
FACILITY: BASIC String Arithmetic 
ABSTRACT: 


This module contains the BASIC a arithmetic functions. 
They operate by calling the STR$ strin 


essesssosoossoossosssso 
MEW OO 


S 
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g arithmetic entry 
points. These routines are coded for reliability and 


003 
3 sit maintainability, not for speed. 
40 one ENVIRONMENT: VAX-11 User Mode 


AUTHOR: John Sauter, CREATION DATE: 02-MAR-1979 
MODIFIED BY: 


1-001 - Original. JBS 05-MAR-1979 
1-002 = Don 


and 1. 

1-003 = Ask STRSRECIP to work to enough accuracy to be sure that the 
result of the givide will be sufficientl 

JBS 07-MAR-197 

Correct the space allocation in PARSE _OUT 5° we have enough 

to hold the entire number. JBS 22-MAR-197 

Correct the sign of the result of COMP%. JBS 22-MAR-1979 

Improve comments based on the code review. S 26-MAR-1979 

Correct a typo introduced in edit 006. JBS 

If we get an error, free local strings. JBS 


t produce 2 heading zero if the result is between 0 
JBS 07-MAR-1979 
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BASSSARITH bes. $Sep-1984 01:10:24 AX-11 Bliss-32 V4.0-74 Page 2 t 
it 12-80-1382 94:88 $$ BASRTL.SRCJBASSARITH.B52;1 . (1) 1 
: 38 38 ! + 1-009 - Cott § shes! STRS $ facility with input scalars by reference. 
; 60 0 1! 1- 19 - fones onsss. and L oss to sits, Rs $4378 -MAY-1979 i 
; 6) 1 1! 1-011 - phenge ce call to STRSCOP Jes i i 
:*.¢ ¢ a pe 2 - . search ty an exact raeetiaake JBS savers i 
;.. & 1 ! 1-015 = When ee ng local strings, watch out for d — tors i 
3; 664 064 1! which have not yer been anitiol ts ed. JBS 7) 3 ‘ 
3; 69 065 1 ! 1-014 = When sag tl the a stri cing ai tocare at least 8 bytes of i 
; 66 066 ii space. 1-029 te 
“= 067 1 ! 1-015 = Try to speed ~ BASS y shortening the quotient search. i 
; 668 o98 7: eave in ollertan caee yoter cf con tional compilation in case i 
3 9 5) 1} $ i needed again. JBS i 
3 0 Q 1! 1*016 = 3.75/35 to one decimal piece me H snttgad of 1.3. To fix this, i 
> 71 71 13 round before hill climbi bing. JBS 13- 
: £ 072 1 ! 1-017 = Added code to routines BASSPLACE and BASSPROD to take care of i 
AR 75 1! the incompatibilities between VAX and the PbP-11 in n handling of i 
; | «676 0074 1! certain R /TRUNCATION parameters loses ttlastie rounding values i 
i ie 0075 1! in the range of | to -4 and. truncation values in the range of i 
; rf pare .% 96 to ). pce nae no i 
Pr 0077 1 ! 1-018 = Changed routine BASSQU0 t call routine STRSDIVIDE instead of ‘ 
; BF 0078 1! the calls to STREMUL STREREC IPS and STRSROUND. LEB 8-OCT-81 ‘ 
g 0079 1 ! 1-019 = Added code to BASS ssau6 to handle compatibility Seblens with ‘ 
; 80 0080 1! regard to 9 tging rt ,e" unnecessary leading or trailing | i 
s 6 CB 0081 1! zeroes. LEB ‘ 
; & 0082 1 ! 1-020 = Changed code in BASSPLACE and BASS$PROD to handle the ROUND : 
; «83 0083 1! TRUNCATION parameters - they now correctly handle values ‘ 
3 Be Boa ; in the. range of -4999 to -1 and in the range of 5001 to 9999. : 
3; 8 0086 1 ! 1-021 = Added Line to BASSCUD tg store updated length field into the i 
; 6Sf 0087 1! descriptor. LEB 2-MAR-82. : 
; 2 «O88 0088 1 ! 1-022 - Added code to PARSE_ iN to allow for an in yt of -0, to fix i 
; wy 0089 1! a@ compatibility mode bug. LEB 29-JUN-19 : 
; 0090 1 ! 1-023 - additional change to PARSE_IN to accept 0° "0. as well. ‘ 
; 91 0091 1! MDL 10-Jan-19 ; 
; 4 0092 1! 1-024 - restore Bo ite LENGTH before calling STRSFREE1_DX in STRSDIVIDE ‘ 
; F 0095 1! to aveld tok ing out the STR$ code and cause an access violation. i 
; 694 0094 1! MDL 15-Mar-1 ‘ 
;s 9 0095 1 !-- ; 
z 96 0096 1 ‘ 
s Ow 0097 1 !<BLF/PAGE> 
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SWITCHES: 


SWITCHES ADDRESSING_MODE (EXTERNAL = GENERAL, NONEXTERNAL = WORD_RELATIVE); 


DBOOOOWD 
‘atv — OOo 


& 


1‘ 

; LINKAGES: 

; NONE 
! TABLE OF CONTENTS: | 


FORWARD ROUTINE 
BAS 


BASSDIF : NOVALUE, 
$P 


Compare eee iags 

Difference between strings 
Shorten a string 

Multiply two strings 
Divide two strings 

Sum of two strings 

Convert to internal form 
Convert to external form 
Handler to free strings 


INCLUDE FILES: 


REQUIRE ‘RTLIN:RTLPSECT’; 
LIBRARY ‘RTLSTARLE'; 


Macros for defining psects 


System definitions 


t 

i MACROS: 

: NONE 
; 

i 


EQUATED SYMBOLS: 


WA. AWA POPPIN PINIPIPUDINININININYDY 2 2 


ITERAL 
+ 


Several of the string arithmetic routines encode the precision and 
a truncation flag in a single pereneter. This is done as follows: 
(PZ is the precision parameter 


PROMIPOPONINONONININPONINONPINOPONoNY 
ye at ee mh bo) 
NOUSWI OOS 


ae 


more, truncation. 


DOOOCOCOCOSOOOOOOCOOSOS COSCO OCOOSOSCOSCOOOCOOOOOOOOOOOOOMNOOOO 


2. If P% is less than or equal to zero, rounding occurs on the 
left side of the decimal point. 


3. If PZ is between 0 and 5000, rounding occurs on the right 
side of the decimal point. 


4. If PZ is between 5000 and 10,000, truncation occurs on the 
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1. If PZ is less than or equal to 5000, rounding occurs; if 
' 
i 
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left side of the decimal point. 


' 
i 
: 5. 1f P% is greater than 10,000, truncation occurs on the right 
side of the decimal point. 


i To help the reader recognize where a. semantics are inplenented. the 
! following symbol is used for 5000 (and 2* the symbol for 10,000) in the 
; above contexts. 


BASSK_PREC_VAL = 5000, 


! There is a Limit imposed by the PDP-11 implementation of BASIC-PLUS=-2 
! on the number of digits which can be processed. This gimic eppears 

! in two places: the precision of QUOS is Limited to 1E=-55 (or 1E=-56 if 
! truncating) and number of digits which can be input is Limited to 60. 
! To help the reader recognize where these Limits are implemented, the 
following constants are defined: 


BASS$K_PREC_LIM1 = 55, ! Max digits in QUO$S when rounding 
BASSK_PREC_LIM2 = 56, ! Max digits in QUO$ when truncating 
BASSK_PREC_LIMS = 60; ! Max digits when scanning input 

! PSECTS: 


ECLARE_PSECTS (BAS); 
OWN STORAGE: 

NONE 
EXTERNAL REFERENCES: 


1 
i 
i 
! 
D Declare psects for BASS facility 
i 
‘ 
i 
i 
i 
i 


EXTERNAL ROUTINE 


rere th : NOVALUE, ' Signals a fatal BASIC error 


' 

BASSSSIGNAL : NOVALUE, : HH pepe a BASIC error 
STRSGET1_DX, ' Allocate a ete 
STRSFREET DX, ! Deallocate a string 

TRSCOPY R ' Copy a string by ref 
LIBSMATCA_COND, ! Match condition codes 
STRSADD : NOVALUE, ! Add two strings 

TRSMUL : ALUE, ' Multiply two Strings : 
STRSRECIP : NOVALUE, ! Take the reciprocal of a string 

$ A Rounds a strin 


STRSROUND : NOV ° 4 
STRSDIVIDE: NOVALUE; ! Divide two strings 


'¢ 
: The following are the error codes used in this module: 


EXTERNAL LITERAL 
BAS 


_DATFORERR : ts ENED (8), ! Data format error 
BAS$K-ILLNUM : UNSIGNED (8) i Illegal number 
BASSK-FLOPOJERR : UNSIGNED (8), i Floating point error 
BAS$K"DIVBY_ZER : UNSIGNED (8); i Division by zero 


1 
1 
1 
1 
1 
1 
1 
1 
2.3 
1 
1! 
1 
1 
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1 
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1 
1 . 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
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F (%x" REP 9 OF (%X'01") REP 198 OF (%x°00")), 
OOF (2x 98335 REEP 287 OF ¢ x06" 5 , 


'\Skip over a gp pte + set of 
'/characters in a string 
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GLOBAL ROUTINE BASSCOMP ( ! Compare stri | 
+14 : Steet operand” 
_ ARG2 ! Second operand 


tee 
FUNCTIONAL DESCRIPTION: 


Compare two strings. This is done by subtracting them and 
testing the result for zero. 


FORMAL PARAMETERS: 


MEUM —"OOONOUE Ww 


ARG1.rt.dx First number to compare, as *#nnn.nnn 

ARG2.rt.dx Number to compare against, as +nnn.nnn 
IMPLICIT INPUTS: 

NONE 


IMPLICIT OUTPUTS: 


' 

' 

NONE 
] 

* 


ROUTINE VALUE: 
COMPLETION CODES: 


0 = ARGs are equal, 

=-1 = ARG! less than ARG2, 

1 = ARG! greater than ARG2. 
SIDE EFFECTS: 


Signals PROLOSSOR (for ‘‘impossible’’ conditions) and the 
signals from PARSE_IN. 


BEGIN 
ANG? : REF BLOCK EB: BYTE; 
m LOCAL 
;_Internal form of ARG! 
A_DESC : BLOCK (8, BYTE) VOLATILE, 


DAMA 


EWN SO ODN NE WN 9 OD NAN WN 0 OONAUE WN (OO ODOVNOUES WN OOONOUW 


RUNS SOw WEAR WR OO NOUR WN DOOR NORWOOD 
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1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
| 


A~SIGN, 
7 A-EXP, 
7 '¢ 
ek : Internal form of ARG2 
7 : B_DESC : BLOCK (8, BYTE) VOLATILE, 
28 0 B-SIGN, 
7 71 B"EXP, 


RASSSARITH ybeseo-1966 01:10:36 yateTT Linge 82 We. 0-748, 


if '¢ 
6, ‘_ Temp to hold A-B. 
2 & C_DESC : BLOCK (8, BYTE] VOLATILE, 
1 ce SIGN, 
f ‘6 CTEXP, 
; _Temp to hold result of comparison. 
RESULT; 


'¢ 
j wnante a handler which will free the strings 


NABLE 
FREE_STRINGS (A_DESC, B_DESC, C_DESC); 


'¢ 

i Convert the two arguments from external form to internal form. 
i This is done by removing the non-digits from the string and 

i returning the ts and exponent as separate values. 

i Errors are signaled. 


A _DESC CoSCSw -LENGTH] = 0; 

DESC CDSC$B~D ped = DSC$K_DTYPE_NU 
A: ESC DScSBqCL LASS = osc K-CLASS~ “Dr 
A-DESC CDSCSA POINTE ER] = 0; 
PARSE_IN (.ARG1 DESC. A_SIGN, A_EXP); 
B pest pscsu LENG? ="0; 
B-DESC COSC$B"DTYPE) = DSCSK_DTYPE_NU; 
B-DESC CDSCSB-CLASS] = DSCSK~CLASS—D; 
B-DESC EDSCSA“POINTER) = = 0; ~ 
PARSE_IN (.ARG2, B_DESC, B.SIGN, B_EXP); 


'¢ 
if the signs differ we can compute the result based on them. 
j Otherwise we must subtract the inputs. 


PePoNofononornonons 
WNOUNE WI SOOO NOM WN OO NONE WOOO VRAD VO DOOD 


C_DESC Dstsu_ LENGTH] = 0; 
C“DESC EDSCSB"DTYPE] = DSC$K_DTYPE_NU 
C“DESC EDSCSB~CLASS) = DS 


i. =CLASS_ “D: 
DSCSA_ POINTER) = 0; 


IF (.A_SIGN NEQ .B_SIGN) 
THEN 


C_SIGN = .B_SIGN 
ELSE 


BEGIN 
” see = 1 = .A_SIGN; ! Change the sign of A 
oes DD (A_SIGN> A_EXP, A_DESC, B_SIGN, B EXP, B_DESC, "sfGNne C_EXP, C_DESC); 


C“DESC 


'¢ 
: We are done with A and B, so free then. 


STRSFREE1_DX (A_DESC); 
STRSFREE1"DX (B-DESC); 


Be Se Ge Se Se Ge Oe Ge Se Se Se Se Ge Se Se Ge Se Se Se Ge Ge Se Ge Se Ge Ge Ge Ge Se Ge Ge Se Fe Ge Se Gs Ge SH Se Se Se Ge Ge Se Se Se Se Se Se Se Ge Ge Ge Se Se Seas 
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‘+ 
Set RESULT based on the sign of the difference between A and B. 
g "RESULT = (IF (.C_SIGN) THEN 1 ELSE -1); 


'¢ 
i If the result is a one-character edge whose digit is zero, 
e 


3 § 5 the arguments were equal. Otherwise y were not. 

: 345 ; 

; $ 3 ff <-C DESC COSCSW_LENGTH] EQLU 1) 

; 4 

. ; cat IF (CHSRCHAR (.C_DESC CDOSCSA_POINTER]) EQL %C‘°O") THEN RESULT = 0; 
; 3 tg ‘6 

: 25 $ We can now free C 

: 354 b6 ’ STRSFREEI DX (C_DESC); 

: 55 44 RETURN (.RESULTJ; 

; 356 48 END; ! end of BASSCOMP 


-TITLE BASSSARITH 
IDENT \1-024\ 


«PSECT _BASSCODE,NOWRT, SHR, PIC.2 


00# 00000 P.AAA: .BYTE 0[49) ; 
01# 00031 BYTE 1(9) : 
00# 0003A “BYTE 0f198) : 
Ow 90190 P.AAB: .BYTE 149} : 
00# 001 1 “BY 0£2073 : 
TABLE_7= P.AAA 
TABLE _NZ= P.AAB 
MASK= “AAC 
.EXTRN BASSSSTOP, BASSSSIGNA 
SEXTRN STRSGET1_OX, STREFREET Dx 
-EXTRN STRSCOPY-R _tON 
-EXTRN STRSADD Sirs 
“EXTRN STRERECIP SROUND 
*EXTRN Srnspivine, Saas DATFORERR 
-EXTRN BASS$K_ILL _FLOPOIERR 
-EXTRN BASSK~DIVBY_ZER 
000¢ 000 .ENTRY BASSCOMP, Save R2,R3 > 0315 
53 000000006 i 9 00 MOV STRSFREE1_DX, R3 ; 
5E ¢ 00 SUBL2 #48, SP : 
C 0000¢ CLRO = C_DESC ; 0353 
Ar 7€ 0000F CLRQ = B“DESC : 
AE 7¢ le A“DESC : 
6D 8 CF DE 0001 6S, (FP) ; | 
E BA 1A A bese ; 96 | 
aon + 3 gun re ahPiy ee 
055 A bestes > 0399 | 


Lemme axaeensea eres Rare toiesomdeneilioctammiteationion 


| 7 
| BASSSARITH 18-5 =1984 01:10:26 AX-11 Bliss-32 V4.0-7%4 p 9 
ot 1 ~3007 138% 94348:8 BASRTL SRETBASSARI SH B42: 1 om «35 
10 AE 9F 00028 SHAB A_EXP 3 0400 
AE OF 8 PUSHAB A”SIGN : 
AE OF F PUSHAB A DESC : 
4 AC OD PUSHL ARG ; 
0000v CF 04 FB CALLS #4, PARSE_IN : 
20 AE Bs 9 CLR B bESC 3 0401 
33 AE F ‘ ¢ v #15, B.DESC+2 ; 0g 
AE 29 4 MOV #2, 8 BESC+3 3 040 
24 AE D4 00044 CLRL  B_DEST+4 ; 06 
AE 9F 00047 PUSHAB B EXP + 0405. 
10 AE 9F O004A PUSHAB B~SIGN : | 
; AE 9F 0004 PUSHAB 8B DESC : 
AC DD 0005 PUSHL ARG : 
0000v CF 04 FB 0005 CALLS #4, PARSE_IN : 
18 AE B4 0005 CLAW C bes¢ : 0410 
1A AE F ; 0058 MOVB #75, C_DESC+2 > 0411. 
18 AE 2 90 0005F MOVB = #2, ¢ BESC+3 ; 041 
1¢ AE 04 00063 CLRL =: C_DEST +4 + 0413. 
Oc AE 14 =A D1 066 CMPL A-SIGN, B_SIGN > 0415 
07 13 00068 BEQL ~=sé«éaS : | 
04 AE 0c AE DO 0006D MOVL 8 SIGN, C_SIGN ; 0417) 
2 i 0072 BRB 28 ; 
16 AE 01 14 AE C3 00074 1$: SUBL3. A_SIGN, #1, A_SIGN : 0420 
18 AE 9F OOO7A PUSHAB ("DESC > 0421. 
04 AE 9F 0007D PUSHAB (C~EXP : | 
OC AE OF 90080 PUSHAB ("SIGN : 
2 «AE OOF 00083 PUS B-DESC F 
18 AE 9F 00086 PUSHAB B EXP : | 
20 AE 9F 00089 PUSHAB B~SIGN ; | 
40 AE 9F 9008¢ PUSHAB AWDESC : | 
ec AE 9F OOO8F PUSHAB A"EXP : | 
4 AE OF 0092 PUSHAB A~SIGN : 
000000006 00 09 FB 0009 CALLS #9, STRSADD : 
28 AE OF 0009C 28: PUSHAB A_bESC ; 0427 
63 01 FB 0009F CALLS #7, STRSFREE1_DXx ; 
20 AE OF O0A2 PUSHAB B_DESC : 0428 | 
63 01 FB OOOA CALLS #1, STRSFREE1_DXx ; | 
05 06 AE €E9 000A8 BLBC 3. C_ SIGN 3 0432 | 
52 01 oO AC MOVL #7, RESULT F 
3 1 BR 4$ 3 
52 i CE MNEGL #1, RESULT : 
01 18 AE 8 CHP besc, #1 ; 0438 
30 1¢ $f CMPB aC DESC+4, #48 > 0441 | 
12 BNEQ 3 
p4 CLRL RESULT : 
3 " 8 i CALS” BT SERSFREET_ DX Asad 
$5 2 5 MOVL RESULT, RO. ~ ; 9a? | 
4 RET ; Bee | 
00 WORD sexe nothing ; 035 
50 08 aC D MOVL (AP), R : 
50 4 ef 0 MOVL 4(RO). R F 
E a 9x PUSHAB C¢_DES¢ : 
FO AO OF PUSHAB B~DESC : 
FB AO OOF PUSHAB A7DESC : 
03 OD PUSHL #3 : 


eae 


3; Routine Size: 


s ee 


237 bytes, 


0449 1 


7E 
0000v CF 


Routine Base: 


7 
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: Internal form of OP1. 
: A_DESC : BLOCK (8, BYTE] VOLATILE, 
A-SIGN 


A_EXP, 
: Internal form of OP2. 
: B DESC : : BLOCK (8, BYTE] VOLATILE, 


B-EX xPe 


; O 1 GLOBAL ROUTINE BASSDIF ( ! Subtract strings 
; 451 1 DIF DESC, i Difference 
; 4 ¢ 1 OP1_DESC, i First input 
: 4 1 OP2_ DESC i Second input 
H 454 1 ) : NOVALUE = 

$ 455 1 

3: 4 : 1 S44 

3 t2 ! FUNCTIONAL DESCRIPTION: 

; 0435 : } Subtract two strings. DIF := OP1 = OP2 

; Bes } } FORMAL PARAMETERS: 

3 468 1! DIF _DESC.wt.dx The difference, OP1 = OP2 

3 0464 1! OP1~ “DESC. rt.d dx Operand OP1 

5 Bee? : OP2-DESC.rt.dx Operand OP2 

3 0467 1 ! IMPLICIT INPUTS: 

3 0468 1! 

; 0469 1! NONE 

: 0470 1! 

; 0471 1 ! IMPLICIT OUTPUTS: 

; 9 1! 

3 0475 1! NONE 

$ 0474 1! 

3 0475 1 ! ROUTINE VALUE: 

3 0476 1 ! COMPLETION CODES: 

3 0477 1! 

3 0478 1! NONE 

3 0479 1! 

3 pee : SIDE EFFECTS: 

3 0482 1! Signals PROLOSSOR for seregte impossible’ errors, and the signals 
; 0483 1! from PARSE_IN and PARSE_O 

3 0484 1! 

; 0485 1 !-- 

3 at) 1 

3 048 BEGIN 

3 0488 

; 0489 P 

3 0490 OP1_DESC : REF BLOCK (8, ByTed. 

3 0491 OP2_DESC : REF BLOCK (8, BYTE], 

; nee DIF_DESC : REF BLOCK (8, BYTE); 

3 0494 LOCAL 


— 


8 
1 


| 8 
BASSSARITH 1b-se -1984 01:10:24 AX-11 Bliss-32 V4.0-74 Page 12 
atti 12288-1386 O11: 9 BSRTL she IBASSARI GH BS2:1 ° (4) 


3 ‘6 0507 '+ 

: ? rN Internal form of the difference, OP1 = OP2. 

; ci 316 . CDESC : BLOCK C8, BYTE] VOLATILE, 

: 421 S18 C7EXP; 

: ¢ ¢ ae 1+ 

: 624 0515 i Enable a handler to free the strings. 
: 238 g819 § | 
: 427 0518 ENABLE 

; 428 51 FREE_STRINGS (A_DESC, B_DESC, C_DESC); 

eo Bee 

: 431 0338 i Convert the two input arguments from external form to internal form. 

3 $36 B25 ! This is done by removing the non-digits from the string and 

3; 43 0524 ! returning the sign and exponent as separate values. 

3 rh 825? Signal any errors. 

: 436 0527 2  A_DESC CDSC$W_LENGTH] = 0; 

> 437 0528 A-DESC CDSCS$B-DTYPE] = DSCSK_DTYPE_NU; | 
; 438 0529 A_DESC CDSCS$B_CLASSJ = DSCSK_CLASS_D; 
3; 439 0530 2 A_DESC CDSCSA_POINTER] = 0; 
; 440 033) PARSE_IN (.OPT_DESC, A_DESC, A_SIGN, A_EXP); 

3; 441 05 ; B_DEST DSC$W_CENGTHI = 0; 

> 442 053 BDESC COSCSB-DTYPE] = DSCSK_DTYPE_NU; 

3: 4463 0534 2 B_DESC CDSC$B_CLASSJ = DSCS$K_CLASS_D; 

3 444 0535 2 DESC CDSCSA_POINTER] = 0; 

3 rh 8236 § A PARSE_IN (.0P2_DESC, B_DESC, B_SIGN, B_EXP); 

3 447 0538 2 ! Subtract the numbers using the Large-precision string arithmetic 

3 re | B278 2 : package. 

; 450 0541 : "  €_DESC COSC$W_LENGTH) = 0; 

: 451 054 § C_DESC CDSCSB_DTYPE] = DSCSK_DTYPE_NU; 

; 452 054 C_DESC CDSCS$B_CLASSJ = DSCSK_CLASS_D; 

: 4553 0544 § C_DESC CDSCSA_POINTER) = 0; : 

3 454 0545 B_SIGN = 1 = .B_SIGN; ! Change the sign of B. 

: tH beeo § ia STRSADD (A_SIGN, A_EXP, A_DESC, B_SIGN, B_EXP, B_DESC, C_SIGN, C_EXP, C_DESC); 

; ttf o268 We are done with A and B, so free them. 

: 459 0930 " STRSFREE1_DX (A_DESC); 

: $60 0551 ,.  STRSFREE1DX (B-DESC); 

; rr] 0388 Convert the difference to external form for the caller. 

: rr} 3232 PARSE_OUT (C_DESC, .C_SIGN, .C_EXP, .DIF_DESC); 

: 406 0357 ! We can now free C 

> 468 §339 " STRSFREE1_DX (C_DESC); 

3; 669 gene RETURN; 

; 670 561 ND; ' end of BASSDIF 
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ARITH te -1984 01: AX-11 Bliss-32 v4.0-7 P 14 F 
passe . sfeiage tg 9 £10: $3 BASRTL.SRC BASSARITH.B 2:1 oe 6d} 1 
50 04 AO DO 00088 MOVL  4(RO), RO ; | 

£8 AO OF ooBC PUSHAB C_DES¢ ; 

FO «AO OF O00BF PUSHAB 8 ~DESC ; 

Fe OS bb boars PUSH aS 

9? pp 00¢7 PUSHL $P ; 

7E 04 AC 7D 00009 MOVO 4(AP), =(SP) : 

0000v CF 03 fe 900cD CALLS #3, FREE_STRINGS ; 


; Routine Size: 211 bytes, Routine Base: _BASSCODE + O2EE 


3; 471 0562 #1 


2 EO ooo 


8 
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GLOBAL ROUTINE BASSPLACE ( ! Round or truncate a string 
Fe DESC, ' Result 
OP1 DESC, ' Number to be rounded/truncated 
PRECISION ! Digits of result 
) : NOVALUE = 


+ 
FUNCTIONAL DESCRIPTION: 


Round or truncate a string to a port ieuter position after 
(or before) the decimal point. RESULT = round (0P1) 


FORMAL PARAMETERS: 
RESULT _DESC.wt.dx The result of rounding/truncating OP1 
OP1_DESC.rt.dx Operand OP1 
PRECISION.rl.v Number of digits to retain and, encoded, 
the round/truncate flag. 


IMPLICIT INPUTS: 


494 NONE 

$38 IMPLICIT OUTPUTS: 
NONE 

499 


ROUTINE VALUE: 
COMPLETION CODES: 


NONE 
SIDE EFFECTS: 


Signals PROLOSSOR for certain ‘‘impossible’’ errors, and the signals 
from PARSE_IN and PARSE_OUT. 


CNAME WN $9 ODNAOUNS WN S(O OONOUV Swiss "O00 Ww 


OOCOSCGOOCSCOOOOCOCOOCOOOOCOOSB OOOO OOOOOOSOOoOoOO 


Ah Ab Ab AD Ab AL eAL AL AL Ab Ab ab Ab ah Ab ab Ab Ab ab ab ah abd ales) ale wales) 


SELESRELLS 


06 oe 
06 
Bes BEGIN 
0 
0604 
0605 OP1 DESC : REF BLOCK (8, BYTE) 


RESOLT_DESC : REF BLOCK C8, BYTE); 
LOCAL 
'¢ 
: Internal form of OP1. 
; A_DESC : BLOCK (8, BYTE] VOLATILE, 
A_SIGN 


SEE 


oO 
PRoPRoNORONORONONONONONONOPUNONDNODS 4 0 9 2 2 9 9 


FUN “OC O@WNOUEWN OO 


A ° 

TRUNC_FLAG, ' 1 = truncate (rather than round) 
v ROUND_POS, ! Where to round 
i The following is a descriptor for the constant 1. It is multiplied by 
! a power of 10 for rounding or truncating. 


PRORIMIMURNONUIND 2 2 
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F 8 
Tea$ep-198e 81:50:99 EBASRTL SRESeASsARitn e682; 1 sae 


ONE _DESC : BLOCK (8, BYTE), 
ONE BUF : VECTOR EF BYTE); 
1 
Enable a handler to free A_DESC in case of error. 


NABLE 
FREE_STRINGS (A_DESC); 


‘+ 
: Convert the input argument from external form to internal form. 

: This ig done by removing the non-digits from the string and 
! returning the sign and exponent as separate values. 

Errors are signaled. 


4 
4 
4 
4 
4 
4 


USWN—O”O 
atttaattaactattee 


VIEWN—O OONOULSWAR' OO OONOUS WN O 


46 06 : 
47 A.DESC CDSCSW_LENGTH) = 0; 3 
48 3 A-DESC CDSCSB-DTYPE] = DSCSK_DTYPE_NU; F 
49 6 DESC LOSCSB_CLASSJ = DSCSK-CLASS_D; 3 
50 Boe A_DESC LDSCSA_POINTER) = 0; 3 
31 064 ; PARSE_IN (.OPT_DESC, A_DESC, A_SIGN, A_EXP); ; 
38 Bee Round or truncate the result to a specified decimal place. 3 
55 064 3 
2$ Bo68 IF (.PRECISION LEQ BASSK_PREC_VAL) : 
064 THEN 3 

58 pers BEGIN F 
59 4 TRUNC_FLAG = 0; : 
60 0650 ROUND-POS = -.PRECISION; : 
re pees $ 
8 peeg BEGIN 3 
64 0654 TRUNC_FLAG = 1; ; 
65 0655 ROUND-POS = =(.PRECISION = (BASSK_PREC_VAL*2)); : 
66 Be28 END; 
67 065 3 
68 0658 '¢ 3 
9 0659 ! In order to do the BASIC rounding/ touncet ten based on decimal place 3 

0 0660 H using the eteine package's rounding/truncation based on number of 3 

7 sed : significant digits, we must be sure that the position we are rounding 3 
§ ! to is part of the significance. Therefore we add 1E<ROUND POS>, F 

7 : round or truncate to discard all lower digits, and then subtract 3 
: : TE<ROUND_POS> to get back to where we belong. 3 

ONE _DESC (CDSC$W_LENGTH) = 1; 3 

ONE _DESC petee-Pr iced = DSCSK_DTYPE_NU; 3 

3 ONE _DESC [DSC$B_CLASS) = iy te $3 : 

ONE _DESC pocss POINTER) = ONE-BUF (0); 3 

0 ONE“BUF (0) = 20'1'; 3 

71 STRSADD (A_SIGN, A_EXP, A_DESC ; 

7 A_SIGN; ROUND_POS, ONE_DESC, i F 

7 A-SIGN, A_EXP> A_DESC)?: ; 

74 STRSROUND (REF (2A EXP ¢ eADESC COSC$W_LENGTH] - .ROUND_POS), TRUNC_FLAG, : $ 

75 A_SIGN, A_EXP, K_DESC ! 3 

7% A-SIGN, AWEXP. AWDESCS; : 


yo 
# 
ASSSARITH 1b-se -1984 01:10:24 AX-11 Bliss-32 V4.0-74 P 7 E 
ease eae ea i 8Re PTEEGSS | Hatsat Oke seasskeifn-c2.1 age 3) 
; 7 77 STRSADD (A_SIGN, A_EXP, A pest. ! ‘ 
; 7 ZREF (TIF (A_SIGNS TREN 0 ELSE 1)), ROUND_POS, ONE_DESC, ! ; 
: 7 A_SIGN, A_EXP> A_DESC); : 
: 59 16 : 
; $3 ¢ ! Check if the precision value is in the range gf -1 to =-4 (indicating 3 
oe 6 ! rounding) or if the value is in the range of 9996 fo 9999 (indicatin : 
; 594 ! truncation). In either case, there is an incompatibility to be fixe 3 
: 36 ° 5 } here, so that VAX BASIC returns the same value as BASIC+2. 3 
: 59 ; 
3 38 4 SELECTONE .PRECISION OF 3 
5 SET 3 
: ony is [-4999 TO -1): ! Rounding parameter 3 
: 60 Og IF .A_EXP NEQ 0 | : 
3 g08 38 3 
; 604 0694 ALEXP = .A_EXP = ABS(.PRECISION); ; 
; 605 0695 eM 3 3 
; 606 069 (5001 TO 9999]: ! Truncation parameter 3 
; 607 069 BEGIN : 
; 608 0698 LOCAL i 
3; 609 0699 TEMP; i 
3 610 0700 TEMP = 10000 = .PRECISION; : 
; 611 0701 IF .4_EXP NEQ 0 | 3 
: ol¢ 244 N 3 
; (61 70 A_EXP = .A_EXP = ABS(.TEMP); ; 
: 6146 704 END; d 
3; 615 0705 TES; ; 
3 oig 0706 3 
3s 61 0707 '¢ é 
3 oi3 44's 4 Convert the product to external form for the caller. 3 
3 ost orig PARSE_OUT (A_DESC, .A_SIGN, .A_EXP, .RESULT_DESC); 3 
3 632 Ore ! We can now free A 3 
5 071 te i 
3 626 0714 STRSFREE1_DX (A_DESC); | ; 
3; 625 0715 RETURN; | 3 
; 626 0716 ND; ! end of BASSPLACES 3 
000c 00000 ENTRY BASSPLACE, Save R2,R3 : 0563 : 
53 000000006 99 9— 0000 HOVAB STRSADD, R3 ; | ; 
E § 00 SUBL #40, SP : é 
Q AE 7C 990¢ CLRQ. = A_ DESC > 0602 | : 
6D 01 CF i OOF MOVAL 9S, (FP) 3 j 
0 AE 8 OO14 CLRW OA b SC ; 96 7 : 
$8 AE of 38 17 MOVB #15, A_DESC+2 3 8 d 
AE 2 1B VB #2, A_BESC+3 : 0639. 
24 AE D4 O00TF CLRL BEST +4 ; 0640 | : 
AE OF é SHAB A_EXP > 0641 | : 
1 AE 9F 38 PUSHAB A_SIGN $ { 
2 AE 9F 028 PUSHAB A_DESC : ‘ 


H 8 
-Sep- 10:26 AX-11 Bliss-32 V4.0-74 Page 18 
ee i ~3007} 382 94348395 BASRTL. seteaeskni sn BS2s1 (5) 
08 AC OD 8 PUSHL  OP1_DESC 7 : | 
#4, "PARSE_IN ; | 
ns : 0c ti 09 5 fot PRECISION; R2 3 0646 
— 3 i BGTR 1 een! 
TRUNC_FLAG ; | 
OC AE ” $5 pe " BNESL R UNROUND POS + 0650. 
a oe Hes 
a $ D8FO ! BP rh ™ MOVAB TTOO0L ROT RO ; 0655 
ae: i c $e $: move’ Re sree =FOS DESC F 066 
eM oe AE 8 2 oe MOVAB ONE BUF, ONE_DESC+4 + 066 
os AE z 35 06 OVB #497 ONE + 0670 
cit 20 AE 99F 0006 PUSHAB A_DESC ~ ; 0671 
14 AE 9F QO06A PUSHAB A. XP ; | 
af i rf 8098 PUSHAB ONE DESC F | 
1c AE OF ite PUSHAB ROURD POS : | 
oR ie MS hale ae 
c AE 9F 0007C PUSHAB A7EXP : | 
gf AE 9F 0O07F PUSHAB A7SIGN 
3 09 FB 0008 CALLS #9, STRSADD : | 
. PUSHAB A_DESC + 0674 
20 AE 9F 0008 A.DES ; | 
eM Stim ae EE eS 
ee a eg a 
3 Ar rt 00094 PUSHAB A7SIGN | 
0 AE 9F 00097 PUSHAB TRUNC FLAG 2 | 
50 $¢ AE 3C O009A mOVZUL ADESC, RO ; | 
10 «AE 26 $f AE $ GOGAs suBLS ROUND POS, RO, 28(SP) : | 
1C AE 9F OOOA | 
000000006 00 08 FB OO0AB CALL S 8, STRSROUND bea! 
20 AE 9F 000B2 PUSHAB A_DES ; | 
ic AE OF 0088 PUSHAB ATSIGN ae 
af AE 9F 000BB PUSHAB ONE DESC ; | 
1C AE 9F OOOBE PUSHAB ROUND PO | 
BLBC A_SIGN, 3$ : 0678. 
05 28 «AE CEO 900C1 L A, Sich. 
ae : 
mo 1 PEE: Bilas Seat” : 
$3 A OF sf : PUSHAB A_DESC ; eer? 
$f AF 3 Op? PUSHAB A7SIGN : | 
09 Fe SODA CALLS #9, STRSADD Fen 
FFFFEC79. BF i Q 0p CPL Re. i- ; | 
E TSTL Re : ) 
ot) oe ws 
50 3) pd 00 FF MOVL 2, RO > 0694 


é 
BASESARITH 1érsenrt964 91:10:24 yaNet BLing=32 y4.-742, Page 19 


ss 
—". . | 


5 19 f2 BLSS $ : 
11 0008 BRB : 
00001389 8F D r6 5$: CPL R , #5001 + 0696 | 
0000270F 8F p} FF cnPL ° , #9999 : ! 
50 00002710 &8F - -< 1 Ane R2, #10000, TEMP : 9700 
10 AE p 11 TSTL «© A_EXP + 0701 | 
11 BEL a8 ; 
dS 0011 STL RO + 0703) 
18 0011 BGEG 07 : 
50 cf 119 gs: vty Re. RO 3 
10 AE C2 0011C 7$: SUBL2 RO, A_EXP : 
04 AC DD 00120 8S: PUSHL RESULT_DESC : 0710 
14 AE DD 001 PUSHL A_EXP : 
1€ AE 0D 00126 PUSHL A-SIGN : 
2€ «AE 9F 00129 PUSHAB A~DESC ; 
0000v CF 04 FB 4 ¢ CALLS 4#%, PARSE_OUT : 
20. AE OF 00131 PUSHAB A_DESC 3 0714 | 
000000006 00 01 FB 001 CALLS #1, STRSFREE1_Dx : | 
04 001 RET : 0716) 
0000 00135C 9$ -WOR sexs nothing ; 0602 
50 08 ac D0 001 3 MOVL (AP), : 
50 04 AO DO 0014 MOVL  4(RO). RO ; 
FB AO 9F 00146 PUSHAB A_DESC ; | 
01 0D 00149 PUSHL fT : 
5E DD 00148 PUSHL  $P : | 
7E 04 AC 7D 0014D MOV 4(AP), = : 
0000v CF 03 FB 00151 CALLS #3, FREE_STRINGS : 
04 00156 RET F 


: Routine Size: 343 bytes, Routine Base: _BASSCODE + 03C1 


3; 627 0717 #1 
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SARITH tbese “19 1:10:24 AX-11 Bliss-32 V4.0-74 P 
43 4 1 ~300n 138% 94238585 HBASRTL SRE BASSARi In BS2:1 ee Bo 
: 6 718 1 GLOBAL ROUTINE BASSPROD ( ! Multiply strings 
3; © 7 1 prop DESC, ' Produc 
; 631 7 1 OP1_BESC, ! First input 
3; 6 ¢ 7 1 OP2 DESC, ' Second input 
3; 6 7 ; 1 PRECISI ' Digits of result 
; 6 7 1 ) : NOVALUE = 
; 6355 724 «1 
3; 6 725 1 S44 
: 6 f § : FUNCTIONAL DESCRIPTION: 
; o7) £ 3 : Multiply two strings. PROD := OP1 * OP2 
s eat f . : : FORMAL PARAMETERS: 
: ro 7 § 1! PROD_DESC.wt.dx The product of OP1 and OP2 
3: 644 7 1! OP1_BESC.rt.dx Operand OP1 
; 645 7 1! OP2 DESC.rt.dx Operand OP2 
3 O66 735 1! PRECISION.rl.v Number of digits to retain and, encoded, 
3 poh 4 f : the round/truncate flag. 
; 649 7 : 1 ! IMPLICIT INPUTS: 
; 650 7 1! 
; 651 740 1! NONE 
3 636 741 1! 
; 65 74 1 ! IMPLICIT OUTPUTS: 
3 654 7435 1! 
; 655 744 1! NONE 
: 656 745 1! 
; 657 74 1 ! ROUTINE VALUE: 
; 658 74 1 ! COMPLETION CODES: 
: 659 748 1! 
; 660 749 1! NONE 
3; 661 0750 1! 
; $66 O75 : SIDE EFFECTS: 
3 664 538 a Signals PROLOSSOR for certain ‘‘impossible’’ errors, and the signals 
3; 665 0754 1! from PARSE_IN and PARSE_OUT. 
3 $66 0755 1! 
; 66 0738 1 fee 
3; 668 fe 1 
; 669 758 BEGIN 
; 670 0759 
3; 671 0760 
3; 67 376) OP1_DESC : REF BLOCK fs. eve}. 
3; 67 76 OP2° DESC : REF BLOCK BYTE 
3 674 76 PROD_DESC : REF BLOCK C8, BYTES; 
3; 675 764 
: 676 765 LOCAL 
3; 677 706 '¢ 
3; 678 76 ' Internal form of OP1. 
3; 679 76 !e 
; 680 76 A_DESC : BLOCK (8, BYTE] VOLATILE, 
. Se Ae 
: re 77 ‘+ . 
3; 684 77 ! Internal form of OP2. 
; 685 774 !- 
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1+ 
: Internal form of the product, A*B. 


C.DESC : BLOCK (8, BYTE] VOLATILE, 


C_SIGN, 

C_EXP, 

TRUNC_FLAG, ! 1 = truncate, 0 = round. 
ROUND _POS, ! Where to round the product 


'¢ 
! This is the constant 1, which is muliplied by a power of 10 for rounding 
: purposes. 


ONE _DESC : BLOCK fs. BYTE], 
ONE BUF : VECTOR L1, BYTEJ; 


'¢ 
: Enable a handler to free the local strings. 


ENABLE 
FREE_STRINGS (A_DESC, B_DESC, C_DESC); 


onvert the two input arguments from external form to internal form. 
his is done by removing the non-digits from the string and 
eturning the sign and exponent as separate values. 

rrors are signaled. 


iy 


W_LENGTH) = 
pve 


ey K_DTYPE_NU; 
LASS 


t 
¢ K"CLASS~D; 
SC, A_SIGN, A_EXP); 


C 
vPEd = DSCSK_DTYPE_NU; 
ASS) = DSCSK~CLASS~D; 
NTER) = 0; 


“PO! 0 
2_DESC, B_DESC, B_SIGN, B_EXP); 
numbers using the large-precision string arithmetic 


OOO 
PO 


= 
- _ 
POINTER] 
ESC, A 


9 NTE 
ENGTHI 3 
L 


oe 
<4 


| aoa 


o 
-D 
C 


2 2 

= \~, ~~) ~ ~~ 4-4] 
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$K_DTYPE_NU; 
$K_CLASS_D; 


bESC, B_SIGN, B_EXP, B_DESC, C_SIGN, C_EXP, C_DESC); 
- so free then. 


0; 
st 
5 
A 


'¢ 


; We are done with 


STRSFREE1_DX (A_DES 
STRSFREE1~DX (B~DES 


i Round or truncate the result to a specified decimal place. 
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1$-$e0-1986 01:10:24 
a (.PRECISION LEQ BASSK_PREC_VAL) 


NBEGIN 
TRUNC FLAG 
ROUND -POS 2 Ob RECISION: 


ELSE 


TRUNC_FLAG = 1; 
ROUND ~ ~POs = =(.PRECISION = (2*BASSK —PREC_VAL)); 


] 

' In order to do the BASIC Founesner erent et en based on decimal place 

: using the ete ing package’s rounding/truncation based on number of 

: sige ficant q'90 ts, we must be sure that the position we are rounding 
! to is part of the significance. Therefore we add 1E<ROUND POS>, 

! round or truncate to discard all lower digits, and then autineaal 

: 1E<ROUND_POS> to get back to where we belong. 


ONE DESC DSC$w -LENGTH) = 1; 
E=D ESC CDSC$B“DTYPE) = “pstsx =DTYPE NU: 
ONE E=p DESC CDSCSB-CLA Kse3 = DSC$K~ ASS": 
E-D DESC CDSCSA~ POIN NTER] = ONE BUF 0): 
ONE sour (06) = 20'1' 
STR SADD (C_SIGN. C nfx?. C_DESC 
C_SIGN> ROUND_POS, ONE_DESC, i 
C"SIGN, C_EXP> C_DESC): 
STRSROUND NtaREF (.C_EXP + .C_DESC COSC$W -LENGTH] - .ROUND_POS), TRUNC_FLAG, 
C_SIGN, C_EXP, C_DESC 
C“SIGN, C~EXP, C ~bEStS; 
STRSADD (C’SIGN, C_ERP, C DESC, 
ZREF (TIF (.C_SIGNS TREN 0 ELSE 1)), ROUND_POS, ONE_DESC, 
C_SIGN, C_EXP> C_DESC); 


'¢ 
i Check if the precision value is in the range of -1 to -4 (indicating 
! rounding) or if the value is in the range of 9996 to 9999 (indicatin 
i truncation). In either case, there is an speenpet roth Tey to be fixe 
ti here, so that VAX BASIC returns the same value as BASIC+ 
SELECTONE -PRECISION OF 
c~s0er te -1): 
IF .C_EXP NEQ 0 
C_EXP = .C_EXP = ABS(.PRECISION); 
500%" A. 9999): 
TOL 


TEMP = "16000 = .PRECISION: 


! Rounding parameter 


! Truncation parameter 
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BASS? a aets 94:48:85 AASRTLe SAE IBASSARI GH 68251 . (33 
; 800 89 IF .C_EXP NEQ 0 
; 801 9 H 
s 4 9 CLEXP = .C_EXP = ABS(.TEMP); 

; 80 9 END; 
; 804 9 TES; 
; 805 94 
3 ene 95 '¢ 
3 rt +33 : Convert the product to external form for the caller. 
: 809 0898 PARSE_OUT (C_DESC, .C_SIGN, .C_EXP, .PROD_DESC); 
3; 810 0899 1+ a a <i = s 
3; 811 900 ' We can now free C 
g aig 901 t= 
; 81 990 STRSFREE1_DX (C_DESC); 
; «6814 090 RETURN; 
3; «815 0904 1 END; ' end of BASSPROD 


001¢ 00000 ENTRY BASSPROD, Save R2,R3,R4 ; 0718) 
$4 000000006 00 9E 00002 MOVAB  STRSADD, R : 
53 000000006 00 9€ 00009 MOVAB  STRSFREE1_ DX, R3 ; | 
SE BB AE 9E 00010 MOVAB =72(SP), SP : 
AE 7C 00014 CLRQ. — €_DESC ; 0758 
38 AE 7C 00017 CLRQ © B_DESC ; 
40 AE 7C OOOIA CLRQ = A“DESC ; 
6D 0180 CF DE 0001D MOVAL 98, (FP) ; 
40 AE B4 00022 CLRW © A_DESC ; 0806. 
42 AE OF 90 0002 MOVB #15, A_DESC+2 ; 0807 | 
43 AE 02 90 00029 MOVB #2, A BESC+3 ; 0808 | 
44 AE D4 00080 CLRL - A_DEST +4 ; 0809 | 
O¢ AE 3F 00030 PUSHAB A_EXP ; 0810 | 
14 AE 9F 0003 PUSHAB A_SIGN ; | 
48 AE 9F 00036 PUSHAB A-DESC ; | 
08 AC DD 00039 PUSHL  OP1_DESC ; | 
0000v CF 04 FB 0003C CALLS #4,~PARSE_IN ; | 
38 «AE B4 00041 CLAW = B_DESC > 0811 | 
3A AE F 90 00044 MOVB #15, B_DESC+2 ; 0812 
3B AE 2 90 00048 MOVB #2, B_BESC+3 ; 0813 | 
3¢ AE 4 O004C CLRL - B_DEST +4 > 0814 | 
04 AE 9F O004F PUSHAB B EXP ; 0815 | 
OC AE Bt 00058 PUSHAB B_SIGN ; | 
40 AE 9F 00 PUSHAB B DESC ; 
OC AC DD 00058 PUSHL  OP2_DESC ; 
0000v CF 04 FB 00058 CALLS #4," PARSE_IN ; 
30 AE B4 0006 cLRW CDESC ; 0820 | 
32 AE OF 90 0006 MOVB #15, C_DESC#2 : O82) 
AE 02 90 0006 MOVB © #2, C_BESC+ : O8¢e 
34 AE D4 00068 CLRL -C_DEST+4 > 0823 
0 AE 9F 0006E PUSHAB ("DESC > 0824 | 
g4 AE 3 00071 PUSHAB (C~EXP ; | 
C AE 9F 00074 PUSHAB (SIGN ; 
44 AE 9F 00077 PUSHAB B_DESC ; 
14 AE QF OOO7A PUSHAB B_EXP ; 
1C AE 9F 0007D PUSHAB B-SIGN ; 
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N 
¢ 
peer REe Pe 
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6000(R25, RO 
ROUND 0s 

7760257, ONE_DESC 
UF, ONE_DESC+4 

NE_BUF 
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ND_POS, RO, 28(SP) 
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Routine Base: 


459 bytes, 


; Routine Size: 
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0905 
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it 1e-88b-198e 11:56:89  EBAsRTL SReaBASSARI IH 04251 oe 9 
; 818 9 1 GLOBAL ROUTINE BAS$QU0 ( ! Divide strings 
; Ht 307 | UO_DESC, i tation 
; 0 9 1 OP1_DESC, ! First input 
: 1 1 P2 DESC, ' Second input 
; ¢ 910 1 PRECISION ' Digits of result 
: 911 1 ) : NOVALUE = 
; 4 316 1 
3 5 91 1 +4 
; $ aie : FUNCTIONAL DESCRIPTION: 
; H 8 8318 1! Divide two strings. QUO := OP1 / OP2 
; 829 94 1! No more than 55 tgite of precision are permitted. 
; 850 916 1! (56 if truncating. 
> 831 0919 1! 
: S36 0920 1 ! FORMAL PARAMETERS: 
; 83 0921 1! 
; 834 09 ¢ 1! QUO_DESC.wt.dx The quotient of OP1 and OP2 
3 839 09 1! OP1_DESC.rt.dx Operand OP1 
; 836 o2S¢ 1! OP2_DESC.rt.dx Operand OP2 
3: 857 0925 1! PRECISION.rl.v Number of digits to retain and, encoded, 
; 838 bass 1! the round/truncate flag. 
; 839 927 1! 
; 840 928 1 ! IMPLICIT INPUTS: 
; «841 929 1! 
; rk 0930 1! NONE 
; 84 0931 1! 
: B44 $335 1 ! IMPLICIT OUTPUTS: 
; 845 0933 1! 
3; 846 0934 1! NONE 
; 847 0935 1! 
; 848 0936 1 ! ROUTINE VALUE: 
; 849 0937 1 ! COMPLETION CODES: 
; 850 0938 1! 
; 851 3494 1! NONE 
3 S26 0940 1! 
; 85 0941 1 ! SIDE EFFECTS: 
: «854 0942 1! 
; 855 09435 1! Signals BAS$_FLOPOIERR if the number of places is greater than 
; $26 0944 1! 55 or 56. Signals BAS$_DIVBY_ZER if the divisor is zero. 
: 857 0945 1! Also, PARSE_IN and PARSE_OUT Signal. 
; 858 0946 1 !-- 
3; 859 0947 1 
; 860 0948 BEGIN 
: He 0949 
; 862 0950 
3; 8635 0951 OP1_DESC : REF BLOCK (8, BYTE), 
3; 864 oe 4 OP2_DESC : REF BLOCK (8, BYTEJ, 
3; 865 O32 QUO_DESC : REF BLOCK (8, BYTE); 
; 866 0954 
: 567 0955 LOCAL 
3 8 0936 '¢ 
; 869 095 ! Internal form of OP1. 
3 370 0958 le 
3 71 0959 A_DESC : BLOCK (8, BYTE) VOLATILE, 
; 376 0960 A_SIGN, 
; 44 0961 ALEXP, 
3; 874 0962 !¢ 


—o | 


0 9 
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1-024 baka ts Yi 91 338:85 BASRTL SRCIBASSARITH.B 2:1 " 3} 
; t? sts H Internal form of OP2. 
3; 87 65 B_DESC : BLOCK (8, BYTE] VOLATILE, 
; 878 6 B_SIGN, 
; 879 96 B_EXP, 
; 880 968 4 
3 rt 83 ; } Internal form of quotient. 
3 ans 971 C_DESC : BLOCK (8, BYTE] VOLATILE, 
> 884 97 C_SIGN, 
; 885 097 C_EXP, 
; 886 974 
; 887 975 RND_TRUNC, ! 0 = truncate, 1 = round 
; 888 097 PRET, ' Number of digits to the 
3; 889 097 ! right of the decimal point 
; 890 0978 END_ADDR, ! End of string address 
; 891 0979 NEW_ADDR, '\Used to store resultant 
; 89 0980 '/address from SPANC 
; 89 981 BUF, ! Pointer to string of digits 
; 982 SAV_ADDR, ! naeare storage address 
; 6895 0963 LENGTH ' Used in SPANC 
>; 896 0984 C_LENGTH, ! Used to store Length of string 
; 897 0985 SAV_C_LEN, ! storage for actual len. of C 
; 898 0986 SAV_C_PTR, ! storage for actual addr of C 
: 899 987 SAV_BOF , ' Storage for buffer address 
3 988 SAV_EXP ! Storage for exp value 
; 901 0989 SAV-LENGTH, ; pcerens for length value 
3 one 344 ve DIFF; ! Used in SPANC to calc offsets 
; 904 099 ! The following FORTRAN subroutines can be used to print the progress of 
; 905 099 ! this routine, if the calls to them are enabled. 
; 906 0994 !- 
3; 907 C 0995 x( 
; 908 C 09 SUBROUTINE MONITOR_] (ICODE, IVAL) 
; 909 C 099 IMPLICIT INTEGER (A-Z) 
; 910 C 0998 TYPE 900, ICODE, IVAL 
> 911 C 0999 2 900 FORMAT (13,16) 
3 até C 1000 RETURN 
; 91 € 1001 END 
3 9146 C Igoe SUBROUTINE MONITOR_T (ICODE, IVAL) 
; «915 C 100 IMPLICIT INTEGER (A-Z) 
: 916 C 1004 Ne bale ict IVAL 
; 318 ; 190% 901 FORMAT Pas oa hele 
$ 315 C 1909 RETURN 
; 920 C 1008 
; 921 1 | 
; 9 ¢ 1010 '¢ 
3 > ? : 1 : In the printout from the above code, 
; 925 1918 : 1 = eps_exp 
; 926 1014 : ; = delfa_exp 
: 927 1015 : =f _pos 
; 928 1 16 : 4 = Cex 
; 929 101 : 5 = tFial_exp 
s 9 1 8 : § = trial digits 
: 931 101 : = ¢ digits 


9 
al HESeocsaee O1:10:05 YACHT SLLSNGRE LEit7 tel 


: 3 195) 3 

: 9 1 é COMPILETIME 

; g 5 ! ? PERFORM_MONITORING = 0; ! Set =1 to get calls to monitors 
; 4 : U3 Z1F PERFORM MONITORING 

: 9 U1 

; 940 u 10 8 eg ROUTINE 

; 941 U 10 MONITOR_I, ! Print an integer 
3 ak U 10350 MONITOR_T; ! Print text 

f 3ta U lose 8 art 

> 945 1038 

3; 946 1034 '+ 

3 ot4 + 5 : Enable a handler to free the local strings in case of error. 
Bb aS eae 

: 333 1039 FREE_STRINGS (A_DESC, B_DESC, C_DESC); 

: 95 1041 2 !¢ 

; 954 Hoh !' Convert the two input arguments from external form to internal form. 
3; 955 104 ! This is done by removing the non-digits from the string and 
3; 956 1044 ! returning the sign and exponent as separate values. 

3 et oF ! Errors are signaled. 

: 959 1047 2 A_DESC [DSCS$W_LENGTH] = 0; 

3 960 1048 A-DESC DS¢$B-DTYPE] = DSC$K_DTYPE_NU; 

; 961 1049 A_DESC CDSCS$B_CLASS] = DSCSK_CLASS_D; 

3 268 1050 A_DESC CDSCSA_POINTER) = 0; 

3 oer 192) PARSE_IN (.OPT_DESC, A_vESC, A_SIGN, A_EXP); 

: 965 1988 B_DESC [DSC$W_LENGTH) = 0; 

; 966 1054 B_DESC petener: toed = DSCSK_DIYPE_NU; 

: 967 1055 B_DESC LDSC$B_CLASSJ = DSCSK_CLASS_D; 

: 968 1928 B_DESC CDSCSA_POINTER]) = 0; 

; 969 105 PARSE_IN (.0P2_DESC, B_peEst, B_SIGN, B_EXP); 

; 970 1938 

3; 971 1059 '¢ 

$ p4h4 Hh 6 : Set up descriptor for internal form of C 

: 97% 1 

; 975 1968 C_DESC [DSC$W_LENGTH] = 0; 

: 976 1064 C“DESC DSC$B-DTYPE] = DSESK_DTYPE_NU; 

3; 977 1065 C_DESC [CDSCSB_CLASSJ = DSCSK_CLASS_D; 

: 978 1966 C“DESC CDSCSA_POINTER) = 0; 

3; 979 Hs 

: 980 1068 '¢ 

: sf 198? : Set up parameters for call to STRSDIVIDE 

; 383 1071 

3: 4984 1 % IF (. PRECISION LEQ BASSK_PREC_VAL) 

; 985 107 THEN 

8 306 1074 BEGIN 

; 98 1075 RND_TRUNC = 1; 

: 988 1076 PREC = .PRECISION; 
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989 77 END 
990 7 ELSE 
991 8 
388 0 RND_TRUNC = 0; 
99 081 PREC = .PRECISION = 2*BASSK_PREC_VAL; 
994 ; END; 
995 
eae 4 '¢ 
99 085 ! for compatability with the PDP-11, don't allow more than 
998 0 6 i §5 or 56 digits to the right of the decimal point. 
999 0 5 : 
091 O84 IF .C_DESCCDSCSW_LENGTH] GTR (BASSK_PREC_LIM2 - .RND_TRUNC) 
$08 091 BASSSSIGNAL (BASSK_FLOPOIERR); 
004 O36 
005 09 
006 094 + 
44 33? : The next section of code is to interface with the new routine STRSDIVIDE. 
009 099 
098 STRSDIVIDE (A_SIGN,A_EXP,A_DESC, 
099 8B _SIGN,B_EXP,B_DESC, 
PREC ,RND-TRUNC; 
IGN, CWEXP,C_DESC); ! Invoke STRSDIVIDE 


ccr 
ee a ee ee ee ee ee ee a ee ee a a a a a ed dd 


em ee ee ee a ed at od ow? 2d od od 


' MONITOR_1 (ZREF (3), ZREF (.ROUND_POS)); 


SARAWVLS 


'¢ 
! The following code is to ensure compatibility with the PDP-11. 
Need to strip off any leading zeroes or any trailing zeroes. 


POIPIPIPIRYD 8 et et ot ot 2 2 
CNOA UEW OO OOVNOUS WN OO 


'¢ 
! save descriptor for C because the following code modifies it and it must 
be restored before calling STRSFREE1_DXx. 


SAV_C_LEN = .C_DESC CDSC$W_LENGTH); 
SAVIC“PTR = .C~DESC CDSCSA~POINTER); 


mon 


OOoCooocooooooooooooo 
ed ot td ot = I IOOO 


ODNAMAE WN OO OONOUE WN “OOO 


'¢ 
! Initial set-up. Set-up pointers to various sections within 
} the resultant string. 


BUF = .C_DESCCDSCS$A_POINTER); Fetch addr of buffer 
C_LENGTH = .C_DESCCDSCS$W LENGTH); Fetch fir of string 
-B0F + .C_LENGTH; of buf 


COCoOoCoCooCoo 


! 

L 
ERD_ADDR = ' Ptr toe fer 
SAV_EXP = .C_EXP; ! Save the exp value 
SAV_LENGTH = .C_LENGTH; ! Save the length of C 
SAV_BUF = .BUF; ! Save ptr to beg of buffer 


'¢ 
! First check if the exponent value if less than the length of 
! the string. If it is, then we know that we have digits to the 


ee ee ee ee ec ce ee ee ec ce ee ee ec ee ee ed ee ed ed ed od od 


APWN=OoDte Mw 


FRRRKLS 


Be Se Se Oe Se Se Se Se Ge Se Se Se Se Se Be Ge Ss Fe Se Ge Fe Fe Se Se Se Se Ss Se He Se Ss Se Se Se Ge Se Ge Se Se Fe Se Ge Se Se SH Se Hs Se SF SS S5 Os Se Se Se Seas 


wr 


' 


ee  —_ -  - r_ -—-_ - a _ — a 


| 


. 
° 
7 
° 
. 
a 
. 
° 
= 
* 
. 
o 
° 
e 
. 
_ 
© 
° 
. 
° 
. 
° 
. 
° 
7 
o 
~ 
° 
. 
6 
7 
° 
° 
° 
7 
. 
a 
° 
° 
. 
a 
© 
o 
o 
° 
= 
° 
° 
° 
. 
° 
° 
oe 
. 
° 
* 
« 
. 
+ 
_* 
. 
° 
. 
° 
. 
° 
. 
o 
. 
ae 
2 
e 
. 
o 
o 
7 
a 
° 
oe 
° 
. 
° 
o 
a 
7 
a 
o 
° 
+. 
° 
. 
° 
° 
a 
2 
° 
* 
© 
” 
& 
o 
e 
= 
° 
. 
° 
. 
° 
. 
* 
+ 
° 


vga ERIM MENUS MOANA Le oP 


—w 


14-Sep-19 BASRTL.SR 
: Left of the decimal point. 


IF (,C_EXP) LSS 0 
THEN 


BEGIN 
IF ABS(.C_LEXP) LSS .C_LENGTH 
THEN 


DWONAVLS WN O OOND 


4 
0 4 
8 4 BEGIN 

4 LENGTH = ABS (.C_EXP); 
99 4 BUF = .BUF + (.CILENGTH + .C_EXP); 
os d LPENGTH = .C_LENGTH 

=. e 

060 4 = 
061 4 '¢ 
06 2 Check for first non-zero digit to right of decimal point. 
064 5 
065 5 NEW_ADDR = SPANC (LENGTH, .BUF,TABLE_NZ,MASK); | 
08 5 IF .NEW_ADDR EQL 0 ‘\Indicates all zeroes to 
06 5 '/right of decimal point 
068 5 THEN 
069 5 BEGIN 
070 5 IF ABS(.C_EXP) GEQ .C_LENGTH 
071 5 THEN 
ore 6 ! Here, Length = exponent value 
07 6 ai ! Just set length to one 
074 6 C_EXP = 0; ! Set exp of result to zero 
Ore é 
077 BEGIN ! Here, exponent < Length 
078 C_LENGTH = .C_LENGTH = ABS(.C_EXP); ! Decr C_LENGTH by the exp value | 
079 C EXP = 0; ! Set exp of result to zero 


END; 
CADESCLOSCSU_LENGTH) = .C_LENGTH; 
ELSE 
'¢ 


! At this point, we have the address of the first non-zero 

i position within the resultant string. Now we need to search 
! for a zero digit. If none, then we know that all the digits 
! to the right of the decimal point are non-zero, and we can 

: leave the exponent value and length value as is. 


BEGIN 
'¢ 


i Start Saorentng for a zero digit. starting at the address 
: returned from the previous SPANC. 


Store updated length 


0909098 NINN SIN SN SIOO OOO 


IF |, NEW_ADDR NEQ .END_ADDR ! If not at end of string 


BEGIN 
WHILE 1 DO 
SAV_ADDR = .NEW_ADDR; ! Save the current addr 


SSSSSSSSSSISSSLSS ESTES 


a a at tk an ak a eh a tk a ak tk at a at a as a ss SS SS os SS Ss YS Ss SS SS Ss YS YY YY 
co 
soc 


ee a em me ed ed ed ed = dd 
ee a a tk dk at ed a = = a 8 2 8 2 2 
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4 
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4 

4 

5 BEGIN 
: C_LENGTH = 1; 

t-4 — 
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4 

4 
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LENGTH = .END_ADDR = .NEW_ADOR; ! Calculate new Length 
NEW_ADDR = SPANC (LENGTH, -NEWADDR, TABLE_2 / MASK); 


IF .NEW_ADDR NEQ 0 ‘\Indicates a zero 
'/digit has been found 


ab Pb 2 a tt 


i Here we know that C_EXP is less than C_LENGTH. 
!' Now we are ready to strip off leading zeroes that 
may exist to the left side of the decimal point. 


: ‘ 
2 38 
0 }) THEN 
ea oe 
19 4 } Now search for a non-zero digit. 
1g 90 SAV_ADDR = .NEW_ADDR; ' Save current address 
1 1 LENGTH = .END ADDR = .NEW_ADDR; ' Calculate Length of string to be search 
14 0¢ NEW_ADDR = SPANC (LENGTH, .NEW_ADDR, TABLE _NZ,MASK) ; 
5 IF ;NEW.ADDR EQL 0 flo match found 
i$ 5 BEGIN 
18 DIFF = .END_ADDR = .SAV_ADDR; '\Calculate Length of 
19 0 p/ pte ins that is zero 
0 08 C_LENGTH = .C_LENGTH = .DIFF; ! Decr length by that amount 
1 09 C"EXP = = (ABS(.C_EXP) = .DIFF); | Decr exponent value by that amount 
; 10 C“DESCCOSC$W_LENGTH] = .C_LENGTH; ! Store updated length 
? 1} BX2TLOOP ! Escape from Loop 
5 ig END 
1 14 ELSE 
i 43 EXITLOOP 
9 i$ END; 
1 3 E wy 
§ , IF | C SAV_EXP LEQ 0) AND (ABS(.SAV_EXP) LSS .SAV_LENGTH) 
§ BEGIN 
5 LOCAL 
¢ LEFT_DIGITS; 
§ i* 
1 
é LEFT_DIGITS = .C_LENGTH = ABS(.C_EXP); ‘\Cale # of digits to 
'‘/Left of decimal point 
¢ NEW_ADDR = SPANC (LEFT_DIGITS,.SAV_BUF , TABLE_NZ,MASK); ;\Search for 
-/non-zero 
of aes EQL 0 ' ALL zeroes to left of D.P. 
BEGIN 
C_LENGTH = .C_LENGTH = .LEFT_DIGITS; ! Decr C_LENGTH 
IF of LENGTA Ear 0 


Ls LENGTH = 1 ! Ensure length of 1 
C_DESCCDSCSA_POINTER] = .SAV_BUF * .LEFT_DIGITS; !Update buffer address 
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SARITH 2% Sep-1 1: AX-11 Bliss-32 v4. P 
be fei Ot Fhi58:85 — FENSare sae feassAni on o$21 al 5 
best NEW ate » SAV BUEE b Gedete Une oryeet 
“DES WaT ees A CBbINTERD = .SAV. BUF + .DIFF;! “Update “buf ter address 


Sicadtead = .C_LENGTH; 


Wro—O0o 


i 
C 
Cp E 
Enpe 
ELSE 
IF rida’ EXP GTR 0 
'¢ 
: Here we know that the exponent value is positive. 


"BEGIN 
NEW_ADDR = SPANC (C_LENGTH,.SAV_BUF , TABLE oNZ,MASK) ; 
IF TNEW_ADDR EQL 0 ~ ‘\Iindicates all zeroes 


i/to left of decimal pt 
og " 
C_LENGTH = 1; ! C_LENGTH = 1 
: P= 0; i Set t exponent to zero 


GIN 
DIFF = NEW ADDR - SAV BUF; 
LENGTH = <C_LENGTH = “DIFF; 
¢ ~DESCLDSCSA. POINTER] ='.SAV. “BUF + .DIFF; 


4 
4 
4 
4 
4 
3 
4 
4 
4 
END; 
CADESC HSC$W_LENGTH] = .C_LENGTH; 


'¢ 
: _Convert the quotient to external form for the caller. 
PARSE_OUT (C_DESC, .C_SIGN, .C_EXP, .QUO_DESC); 


'¢ 
i restore actual length & address of C so we don't fake out STRSFREE1 and cause 
: _an access violation 


C_DESC EDStsAy LENGTH] = .SAV_C_LEN; 
C-DESC 


MIMI 


a kk ek ek kk kt ad ad ed = = = a a 
©0O00e C909 0909 C909 SI NIN NSIS NN PPA OOOO O 
SIIAIBVIIS ASRS aos alee P oR Sse 


SBSVSAP UV LOGSHNE AE MOL OOS NEN UV OSORIO R UNIO DR Ua ARES» 


DSCSA_POINTER] = .SAQ_C_PTR; 


'¢ 
i aad can now free A, B and C 
STRSFREE1_DX (A_DESC); 


STRSFREE1_DX (B-DESC); 
gieeeacel DX (C“DESC); 


ND; ' end of BAS$QU0 


a ee ee me ee ee ee ee a ed ed ed od wd od ed 
ee ed od td = 8 = a 


OFFC 00000 -ENTRY BASS$QUO, Save R2,R3,R4,R5,R6,R7,RB,R9,R10.— ; 0906. 
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¢ 9 78e 
BASRTL. SRC JBASSARITH.852;1 


Be 


R 
SE =o (SP), SP 
fon CLRQ = C_DESC 
ie Hg ee 
6D 02 5 CF DE MOV rr} (FP) 
3C AE CLARY pest 
3 AE OF MOVE #15, A_DESC+2 
FOE : MOVB #2, A BESC+S 
40 AE D4 CLRL s-_«A_DEST* 
4 AE OOF PUSHAB A"EXP 
C AE OOF PUSHAB AWSIGN 
6 AE OOF PUSHAB A~DESC 
08 AC OD PUSHL OP1_DESC 
0000v CF 04 FB CALLS #4,~PARSE_IN 
34 AE B4 CLRu «Oso besc 
3 AE f MOVB #15, B._DESC+2 
AE 2 MOVB © #2, -B_BESC+3 
38 AE D4 CLRL —- B _DEST +4 
C AE OOF PUSHAB B~EXP 
4 AE OOF PUSHAB B7S!I 
C AE OOF PUSHAB 8 p Sc 
€ AC DD PUSHL  OP2_DESC 
0000v CF 04 FB CALLS #4, ~PARSE_IN 
2c (AE OBS CLRW 836s C_ DESC 
ce F MOVB © #TS, ~C_DESC+2 
FOE 2 VB #2, C_BESC+3 
30 AE D4 CLRL 3s. C_ BEST +4 
00001388  8F 10 Ac 01 CMPL PRECISION, #5000 
08 14 BGTR 1$ 
16 AE 1 D MOVL #1, RND_TRUNC 
18 «AE 10 ac p MOVL PRECISION, PREC 
0D BRB $ 
14 AE D4 00075 18: CLRL_ -RND_TRUNC 
18 OA 10 AC 00002710 &8F C3 SUBL3 #10000, PRECISION, PREC 
5 4 OA 8 ¢ 28: SUBL3 #56, RND_TRUNC, RO 
5 CE MNEGL RO, 
50 2c A 1 FD CMPZV #0, #16, C_DESC. RO 
7e 006 BF 9A MOVZBL #BASSK FLOPOIERR, -(SP) 
000000006 1 §B CALLS #1, BASSSSIGNAL 
2 AE 9F 00090 3$ PUSHAB C_DESC 
AE OF PUSHAB C7EXP 
1 AE i PUSHAB (~SIGN 
F PUSHAB RAD_TRUNC 
AE OF PUSHAB PREC 
AE OF PUSHAB B_DESC 
4 AE OF PUSHAB B~EXP 
C AE OOF PUSHAB 87SIGN 
AE OF PUS A-DESC 
48 AE OF PUSHAB A_EXP 
50 AE OF PUS A-SIGN 
00 0B FB CALLS &#T1, STRSDIVIDE 
AE AE 3 mOV2wL C_DESC, SAV_C_LE 
ag AE D MOVL  C7DESC#4, SAV7C_PTR 
; AE p VL CDESC +4: BUF 
4 C AE 3C MOVZWL C7DESC, ¢_LENGTH 
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311 $ é 
ADDR 3 11 r 
Gamay aS ESTE ty We |i 
rt H, AV. ° $ 
| 5A 38 oc 54 4 tia rove a Hey : 1137. : 
D TSTL E : : 
58 oc A Fs Biss 48. ; 1140 : 
et oe ro ar |] 
2 ; CNBC’ ORG C LENGTH : | : 
7 f S$: CMPL ORT. CC. 1143, 
‘ 4 3 BGEQ R7. LENGTH 3 1144) ° 
4 } 06 i ADDL CEXB. C LENGTH, RO pon 
4 oc 35 fh Bat ADDL2 = RO, > 1147. é 
50 3 5? 2! B°8 $ ENGTH ; 1153, : 
P VL C_LENGTH, L NZ, MASK : : 
5 8 OO108 98, SPANC LENGTH, (BUF), TABLE_ | 
915 CF 6 : 116 CURL Ri é 1154 | ; 
sein iia Ss ; DO 00118 8S MOVE RT, NEW_ADDR ; 1158) : 
% ig if By CNPL ORT, C_LENGTH S esas! : 
Dd 9$ . 
om 3 i) oO SUBL2 a, C.LENGTH : 1169. 
54 be Oo19k 108: eLALS ex : 1185, 
oor o 1S 118: fre NEW_ADDR, END_ADDR Fone : 
56 D1 BEQL = 178" R : 1191, : 
5A 48 15 00132 VL Seen? EAD Tappan. LENGTH 1192. : 
- al peal! 
Soe: Page gat ie peel 
tees oh LS uss SH, sewn ie |; 
56 13 00148 Vi_ NEW_ADDR, SAV_ADDR saci : 130) | : 
: ines Ge Hicks: Hate, mse | HE : 
3 66 ; 8 Bie ened is Pal 
dba, ig PD ete Bo O16) 1468: ROVE «RL, NEW_ADDR : 1206. : 
56 : ? 01 ene® SA ADDR, END ADDR, DIFF : 1208 | ; 
00186 ts eee LENGTA : 1209 : 
57 ? E OO1eA MOVE cE, Ro ; 
i Oc AE BO 0016p Boed 158 : 
C 40173 MINE G Ripe DIFF, C_EXP : 1319 . 
39 €3 00176 138 et. CENGTH, CDESC ; 1220 : 
ae 2c $ BS ool Iss: Tete SAY _EXP : 
5 82 for MOVE SAY exp, RO : : 
50 00 001 a ae 

cE 01 MNEGL R ° 

50 


essen 
50 oc 


F980 —s CF F883 


30 = AE 59 


F959 


CF 


F8S5C 


CF 69 


oc 
57 56 


AE 59 
2c AE 
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04 AC 

1 AE 
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0000v CF 04 
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000000006 00 01 

34 AE 

000000006 00 01 

2c AE 

000000006 00 01 
00 

50 08 AC 

50 04 Ad 
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SE 
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0000v CF 0 
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t 188 18%: CMP R9 SAV_LENGTH ; 
i ron mn RO : 1232 
1 BGEQ ‘98 : 
cE 1 MNEG RO, RO ; 
199 19$:  S$UBL3 RO, C_LENGTH, LEFT_DIGITS : 
19D SPANC , FT_BIGITS, (SAV_BUF), TABLE_NZ, MASK 3 1234 
1A BNEQ $ : 
i) 1 CLAL R : 
: 1AA 208:  MOVL 1, NEW_ADDR : 
1AD BNEG 246$ + 123 
‘ 1AF SUBL2 LEFT_DIGITS, C_LENGTH + 123 
06 oolBe move #1) C_LENGTH g 199 
11 00187 BRB 25 ; teri 
5) 0189 21$ ADDL3 LEFT_DIGITS, SAV_BUF, C_DESC+4 1244 
1 O18 BRB $ t 1236) 
D3 1€6 228 TSTL SAV _EXP : 1255) 
15 001¢ BLEG 6$ : 
28 ics SPANC g LENGTH, (SAV_BUF), TABLE_NZ, MASK + 1261 
1 1CD BNEQ 3$ : 
D4 OO1CF CLRL RY : 
09 00101 23$ MOVL  R1, NEW_ADDR : 
12 00104 BNEG 24$ : 1262 | 
DO 00106 MOVL #1, C_LENGTH + 1266) 
D4 00109 CLRL «= C_EXP + 1267 
11 001DC BRB 25$ + 1262 
C3 OOIDE 248 SUBL3. SAV_BUF, NEW_ADDR, DIFF + 1271 
C2 OO1E SUBL DIFF, C LENGTH : 1278 
C1 OO1E ADDLS DIFF. SAV_BUF, C_DESC+4 ; 137 
BO OO1EA 258: OVW  C_LENGTH,~C_DESC : 1275 
DD OO1EE 26$:  PUSHL 00 DES + 1282 
DD OO1F1 PUSHL  C_ERP : 
DD OO01F4 PUSHL C7SIGN : 
OF OO1F7 PUSHAB (DESC ; 
FB OOIFA CALLS #%, PARSE_OUT ; 
80 pier MOVW § SAV_C_LEN? C_DESC 3 1gee 
DO 00204 OVL  SAVC“PTR, C7DESC+4 + 1289 
9F 00209 PUSHAB A_DEST : 1294 
FB 00206 CALLS #T, STRSFREE1_DX Sets 
9F 0021 PUSHAB 8 DESC : 1295 
FB 00216 CALLS #1, STRSFREE1_DX ; | 
9F 00210 PUSHAB (C_DESC : 1296. 
FB 0 9 CALLS #7, STRSFREE1_DXx ; 
04 ET : 1298 
0 00228 27% - WORD sexe nothing : 0948 | 
00 022A MOVL (AP), RO ; | 
; 6 MOVL 4(RO). R : | 
F PUSHAB (_DESC : 
oF PUSHAB B-DESC ; 
OF PUSHAB A~DESC F 
DD B PUSHL #3 : 
D D PUSHL SP ; 
D F VQ 4(AP), =-(SP) ; 
FB 43 CALLS #3, FREE_STRINGS ; 
04 0024 eT F 
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“mOO2Z oe«€« coo - 2e 2wue- Zu nw 2 oomMw 4 8@© «<a 8 OOo 
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:26 -VAX=11 BLiss-32 V4.0-7 Page 38. 
6 PaNsat esha saneskei on aSes1 oe 3 


‘+ 
- Internal form of the sum, OP1 + OP2. 
C_DESC : BLOCK (8, BYTE] VOLATILE, 


C-SIGN, 
CTEXP; 


14 
; Lene a handler to free the local strings in case of error. | 


oF ENABLE 
$2 FREE_STRINGS (A_DESC, B_DESC, C_DESC); 
84 71 '¢ 
85 Le i Convert the two input arguments from external form to internal form. | 
86 7 ! This is done by removing the non-digits from the string and 
87 74 i returning the sign and exponent as separate values. 
M4 Le | frrers are signaled. | 
90 77 A_DESC CDSCS$W_LENGTH] = 0; 
91 78 A_DESC CDSC$B_DTYPE ed = DSCSK_DTYPE_NU 
3 79 A_DESC CDSCS$B_CLASS] = DSCSK_CLASS “Dy 
g 80 A_DESC CDSCSA_POINTER) = 0; 
94 81 (.OPT_DESC, ADESC, A_SIGN, A_EXP); 
95 3 B_DESC COSC$W_CENGTH) = 
B-DESC CDSCSB_DTYPE] = DSCS$K_DTYPE_NU; 
B_DESC CDSC$B_ LASS. = DSC$K_ CLASS “0; 
B_DESC LDSCSA-P OINTER]) = 0; 
PARSE_IN (.OP po. “DESC, B_DESC, B_SIGN, B_EXP); 


'¢ 
Add the numbers using the large-precision string arithmetic package. 


C_DESC (CDSC$W “LENGTH = 
DSC$B_ 


BNO SRE 


C“DESC DTYPE = psise _DTYPE_NU; 
: “DESC CDSCSB_ cLASs = OSC SK. ~CLASS_D; | 
C“DESC COSCSA POINTE 
1 STRSADD (A_SIGN, A_EXP, “A “Bese, B_SIGN, BLEXP, B_DESC, C_SIGN, C_EXP, C_DESC); 
t We are done with A and B, so free them. 


STRSFREE1_DX (A_DESC); 
ze STRSFREE1_DX (B-DESC); 


: Convert the sum to external form for the caller. 
. PARSE _OUT (C_DESC, .C_SIGN, .C_EXP, .SUM_DESC); 
; We can now free C 
" STRSFREE1_DX (C_DESC); 
RETURN; 
ND; ! end of BASSSUM 
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oo er if 8% BASRTL: SRE citi 2:1 roe 


FB a0 9F 000BC PUSHAB A_DESC : 

Q DD O00BF PUSHL #3 : 

E 0D 000C1 PUSHL SP : 

7E 04 AC 7D 000C3 mMOVa 4(AP : 

0000v CF 03 FB 000C7 CALLS #3, PRE. “STRINGS F 
04 000CC RET ; 


; Routine Size: 205 bytes, Routine Base: _BASSCODE + 0923 


3; 1323 : 1410 1 


WARS ae SIE i RD Ea are ni ted TN a A Us et eR 


10 

ASSSARITH 1$-Se -1984 01:10:24 AX-11 Bliss-32 V4.0-74 
et 12-808-1 38 94:58:45 EBASRTL SRe BASSARITH.852;1 
: 1325 1411 1 ROUTINE PARSE_IN ( ! Scan a number and divide it up 
3 1 § 1216 1 ARG ° ! The number to scan 

: 1 1415 1 DIGITS, ! Where to put the digits 

; 1328 1414 1 SIGN, ! Where to put the sign 

3; 1329 1415 1 EXPONENT ! Where to put the power of ten 
; 1330 1613 1 ) : NOVALUE = 

: 1331 1417 1 

3 3 ¢ 1ei8 1 le+ 

3 ; eh : FUNCTIONAL DESCRIPTION: 

; 1355 1421 1! Convert a numeric eer ing of the form ¢nnn.nnn into a digit 

3 7 14 ¢ ,? 7 and a separate sign and decimal exponent. Don't allow 

5 ; , 1? Z : more than 60 digits, for compatability with the PDP-11. 

3; 1339 1425 1 ! FORMAL PARAMETERS: 

3: 1340 14 : 1! 

3 1341 V4 1! ARG_DESC.rt.dx The number to parse 

: 1 ; 1428 1! DIGITS.wnu.dx Where to put the digits found 

3s 3 1429 1! SIGN.wl.r 0 = positive, 1 = negative 

3 1344 1430 1! EXPONENT.wl.r Decimal exponent 

3: 1345 1431 1! 

3: 1346 1o36 1 ! IMPLICIT INPUTS: 

: it ri 163 1! 

3; 1348 1434 1! NONE 
3: 1349 1435 1! 
; 1350 1436 1°! IMPLICIT OUTPUTS: 
3 1351 1437 1! 

3 Y 26 1438 1! NONE 
3 132 1439 1! 
3 1354 1440 1 ! ROUTINE VALUE: 
: 132? 1441 1 ! COMPLETION CODES: 
3; 1356 ar 1! 
3; 1357 1443 1! NONE 
; 1358 1444 1! 
; : 59 bt ; : SIDE EFFECTS: 
3; 1361 1447 1! Signals BASS_ILLNUM if there are more than 60 digit, 

3 1306 1448 1! BASS_DATFORERR if the syntax of the number is wrong, 

3 ; re : and also signals if storage is exhausted. 
3 1 1451 1 !<- 
: 1 1036 1 
3 1 145 BEGIN 
3 7 1454 

3 1 1455 MAP 

3 1 1628 ARG_DESC : REF BLOCK (8, BYTE), 

i] 145 DIGITS : REF BLOCK (8, BYTE); 

3 3 1489 LOCAL 

? 1460 '¢ 

: } 1693 The following three locals hold the internal form of the number. 

3% 1268 SIGN_VAL, 

es | 1464 BUF _BESC : BLOCK (8, BYTE) VOLATILE, 

: 1 1465 EXPON 

3 7 1608 SIGN_ SEEN, ! 1 = we have scanned a*+or- | 
: 146 DIGIT_SEEN, ! 1 = we have seen at least one digit 


Pa 41 
= (9) 


— 


co 
oo 
Fd dk e_e- De kee et tet a 


te + tat ted te tet PRN RP 


SSVSS2Es2 


OWONAUESWN $C OONOUS WOOO 


ooono 


MEWN—o 


PPPS INE BS EEE EEE 
oOoooo°o 


RUN SOBNI AW HOSS EAE WU ODOR RI LOD 
SF 


a Te ee ee en ee ee ee SS 
ed ee ed ed ed ed td = OOO 


FoF oF oF oF ot at oe ot ot ot at at tt atte 2 ee ek ed el ek kd tt 


1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 


5 
5 
5 
5 
5 
5 
5 
5 
5 
5 
; 
5 
5 


: 


FWUN OC OCOwouflwnr—0o0 


SISRFUNSSSeNo 


4 01:10:24 AX-11 Bliss-32 V4.0-74 

Hn 94548385 BASRTL. RCIBASSARITH.B 2;1 
1 = we have seen a decimal point 
1 = we have seen trailing blanks 
Counts position in the output buffer 
Addresses result 
Addresses source 
Length of the source 


16 10 19 
-sepo- 
1a-Sep-19 
DOT SEEN . 
BLANKS_ SEEN, i 
PUTTER 
i 
$ 


1+ 
Enable a handler to free the local string in case of an error. 


ENABLE 
FREE_STRINGS (BUF DESC); 


Allocate enough space to hold the digits. It is convenient to 
allocate before scanning, so we may allocate a Little too much, 
but the space will be freed before we return. - 

Note that we must fetch the length field of the descriptor only 
once, so that we will not attempt to overrun our local string if 
the source is reallocated longer by an AST. 


BUF _DESC [DSC$W_LENGTH] = 0; 
BUF “DESC CDSC$B-DTYPE) = sf 
0 
L 


2 DSC$K_DTYPE_NU; 
BUF-DESC CDSCSB-CLASS] = DSCSK~CLASS_D; 
BUF-DESC CDSCSA-POINTER] = 
G-LEN = .ARG DESC CDSC$W_LENGTH); 
,, STRSGETI_OX (REF (.ARG_LER + 8), BUF _DESC); 


Now scan the incoming number. 


$ 
4 
E 


INCR GETTER FROM 0 TO (.ARG_LEN = 1) DO 
aeLerT pe -ARG C.GETTER) OF 


CZc°+") : 
BEGIN ! Plus sign 


IF (.SIGN_SEEN OR .DIGIT_SEEN OR .DOT_SEEN OR .BLANKS_SEEN) THEN BASSSSTOP (BASSK_DATFORERR) 


SIGN_SEEN = 1; 
SISN_VAL = 0; 


(zc'=") : : 
BEGIN ! Minus sign 


De Se Oe Oe Oe Se Be Oe Ge Se Se Be Be Se Se Ge Se Se Fe Se Se Se Ge Se Ge Fe Se Fe Se oe Ge Ge Se Se Se Ge Se Se Se Se Se Se Se Se Se Se Se Se Se See Fe Se Seaseeas 


10 
BASSSARITH sS-Seo-1984 01:10:24 Want Blisg=$2 v4-00742, Page 43 


; 1439 1525 

; 1228 1 § IF (.SIGN_SEEN OR .DIGIT_SEEN OR .DOT_SEEN OR .BLANKS_SEEN) THEN BASSSSTOP (BASSK_DATFORERR) 
3 1$6¢ 1 8 SIGN_SEEN = 1; 

3 144 1 SIGN_VAL = 1; 

3 14466 1 ? ; 

3; 14465 1 

3 Pre | 1 § ly BO 

3 vat 4 : BEGIN ! Decimal point 

; He : 5 IF (.DOT_SEEN OR .BLANKS_SEEN) THEN BASSSSTOP (BASS$K_DATFORERR); 

; 1484 12 DOT_SEEN = 1; 

; 1458 1 END? | 
3 145 1 

3 14546 154 (zc° *j ;: | 
3 1322 136) BEGIN ! Blank, better be leading or trailing. 

3 1289 1308 IF (.SIGN_SEEN OR .DIGIT_SEEN OR .DOT_SEEN) THEN BLANKS_SEEN = 1; 
3; 1458 1544 
3 1459 1545 END; 

3: 1460 1266 

3: 1461 154 Czc'O" TO &C°9") : 

; re «1 1368 BEGIN ! Decimal digit 

; Hye} 1330 IF (.BLANKS_SEEN) THEN BASSSSTOP (BASSK_DATFORERR); 

: 1466 1326 $ IF (.DIGIT SEEN OR .DOT_SEEN OR (.SIGN_VAL EQL 1) OR 

3 1467 155 : (.ARG CUGETTER] NEQ 2C'0')) 

3 1468 1554 ! THE | 
s rs 14 133? & BEGIN 
: 1470 15 $ 4 !+ 

3 1471 1557 4 ! This is not a leading zero 

3 1076 1558 4 !- 

3 147 1559 4 DIGIT_SEEN = _1; 

3 14746 1260 4 BUF C.PUTTER) = .ARG C.GETTER); 

3 1475 1561 4 PUTTER = .PUTTER + 1; 

3: 1476 1286 & 

3; 1477 1565 4 IF (.DOT_SEEN) THEN EXPON = .EXPON = 1; 

: 1478 1564 4 

3 1479 1565 END; 

3; 1480 1566 

3 1481 1567 END; 

3 1o86 1268 

3 14 1 $ COTHERWISE) : 

3 1484 1570 BASSSSTOP (BASSK_DATFORERR); 

3: 1485 130) TES; 

3 1008 1 % 

: 188 1354 § i’this is the end of the INCR t 

: ! s is the ) e oop. 

: 1289 13 te 

3; 1490 157 

3 1491 157 If ( NOT .DIGIT_SEEN) 

3 1638 157 

3: 149 157 BEGIN 

3 1494 138 '¢ . c 

3; 1495 1581 ! If there are no digits, or only leading zeros, take the number to 
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w$ep-1986 11:56:99 EBASRTL SRE SBASSMAITH.082;1 


: be zero. Don't be too gullible, however. 


If (.SIGN_SEEN OR .DOT_SEEN OR .BLANKS_SEEN) THEN BASSSSTOP (BASSK_DATFORERR); 
,PUTTER] = 2C°O'; 


BUF f 
PUTTER = .PUTTER + 1; 
END; 


'¢ 


i If there are more than 60 digits in the number, reject it for compatabliity 


: with the PDP-11. 


IF (.PUTTER GTR BASSK_PREC_LIM3) THEN BASSSSTOP (BASSK_ILLNUM); 


t¢ 


! If we make it to here the number is in proper form. 
: Return it to the caller. 


-SIGN = .SIGN_VAL; 
XPON; 

IGITS, PUTTER, .BUF); 
; Free our local string 


. EXPONENT 


NT =. 
STRSCOPY_R (. 


'¢ 


STRSFREE1_DX (BUF _DESC); 
END; 


000000006 


OFFC 00000 


OP VIVU"™DWOLlo 


o 


! end of PARSE_IN 


PARSE _IN: 


Save R2,R3,R4,R5,R6,R7,R8,R9I,R10,R11 


UF DESC 
43> (FP) 


FD 
#15, BUF DESC+2 
#2, BUF _BESC+3 
st+ 


STRSGET1 Dx 
ESC+4, BuF 


wt a a et bd a a 


PPAPAMASIIN 


=SESRALS 


19 - Pa 45 
=-Sep-1984 01:10:24 AX=11 Bliss-32 V4.0-74 ; ge 
#43 wee 1b-be0-1984 94348395 YBASRTL SRE BASSARITH.B32;1 (9) 
2 6945 9A 00048 1$: MOVZBL (GETTER) CARG], R2 i ose 
36 9 GF CMPBOR2, #43 ; 
E BBS SIGN SEEN, 2 ; 1517 
8 BL8BS DIGIT SEEN, 2$ ; 
4 BLBS DOT SEEN, o$ ; 
4 BLBC = BLARKS_SEEN, 3$ : 
006 &F 5A 6 28: ROVZBL BBASSKDATFORERR, (SP) ; | 
LL : ; 
6st 0 1 06 10068 3$: nOvL #1, SIGN_SEEN ; 1338 
A if enPB » "45 ; 1335, 
20 52 91 4$ CM R : | 
45 4 SLBS SIGN_SEEN, 5$ ; 1526, 
8 E BLBS DIGIT _SEEN, 5$ ; | 
T SEEN, 5$ : 
4 £9 Bree BLANKS SEEN 6$ ; | 
F BR 5$: MOVZBL #BASSK~DATFORERR, -(SP) : | 
00000000 _ ; CALLS #1, BASS$$STO ; 
. g i 50 6$: MOVL #1. SIGN_SEE ; 1528 
on : i BRE" 178 etl 8 ; 131) 
2E $3 91 00096 7$ CMPB Re #46 | 
se 8 BLBS DOT SEEN, 8$ ; 1535) 
83 6 3 BLBC BLANKS SEEN, 9$ : 
oe 00G 8F H 8$: novzet #BASSK DATFORERR, -(SP) | 
: 1537 
ee 9? 61 09 $ MOVE “i, DOT_SEEN ; 137 
20 33 91 108 CMPB Re, #32 ; | 
5 : BBs tien SEEN, 11$ ; 1543 
s ti Se Mere Ped 
L _SEEN, 
36 ; 4 11$: MOVE #, BLANKS_SEEN § asi] 
> tt $ BRB 1 a8 ete 
30 91 138: CMPB R , ; | 
1F BLSSU. 1 ; ; | 
39 91 CMPB Re as ; | 
; ‘9 BeBe’ BLANKS SEEN, 14$ ; 1550 
98 006 ? 7H MOVZBL M#BASSK~DATFORERR, -(SP) ; | 
000000006 of 1 £8 G00 | ALLS). BASEESIOR s 
04 a } 08 Le MOVE Ree SPUTTERLBUF 3 ; 1369 
= § b8 Nae DOT SEEN, 17$ ; 1563 | 
OF oS. BLBC ; | 
tt 158: one Toeen : 1511 
00G BF 9A 16$: nOVZBL #BASSK DATFORERR, -(SP) oa 
een oh h ‘3 178: AOBLSS ARG LEN, GETTER, 18$ ; 
1¢ rag I 158: BLBS DIGIT_SEEN, 228 : 157 


ASSSARITH 18-50 “1 1:10:26 AX-11 Bliss-32 v4.0 P 46 , 
ot ~peen 38S FUEE8:85 = HaNSat esa aassanin-o$2:1 age 9) 1 
7 1 LBS  SIGN_SEEN, 20S : 1585 
4 01 LBS DOT SEEN 268. : 
6 i BLBC BL ARK SEEN ; 
006 &F D10E 208: MOVZBL BBASSK K DATFORERR, -(SP) : 
000000006 1 1 CALLS s S$$sT : | 
BE - 30 4 21$: ROVE no SPUTTERCBUF : 1387 
3¢ 4 A 4 228: ses PYITER, #60 + 1596. 
7 006 &F 1 MOVZBL #BASSK_ILLNUM, =(SP) ; 
000000006 66 1 D1 CALLS a Saseee tor’ : 
¢ BC 8 0132 23$: MOVL SIGN VAL, @SIGN : 1 4 
BC § 01 VL‘ EXPOR, bEXPONENT : 1603. 
013A PUSHL BUF : 1604 | 
08 AE 01 3¢ 5 PUTTER : 
A 0136 PUSHL DIGITS : 
000000006 00 0 d142 CALLS #3, STRSCOPY_R : 
08 A 014 PUSHAB BUF _DESC ; 1608 | 
000000006 00 0 d14¢ CALLS #1, STRSFREE1_Dx ; | 
o13 RET : 1609| 
‘4 4 24% .WORD foxg. g nothing + 1453) 
50 08 ac 136 MOVL (AP), RO : | 
50 04 AO 015A MOVL  4(RO), RO : 
F8 AO 015€ PUSHAB BUF det : 
1 O16] PUSHL #1 ~ : 
E 163 SHL SP : 
7E 04 AC 7D 0016 va. 4 (AP F | 
o000v CF 03 FB 00169 CALLS #3, thee: STRINGS F 
04 0016E ET ; 


; Routine Size: 367 bytes. Routine Base: _BASSCODE + 09F0 


SRS 2 FESO RE eae ea en Sf” Bpeeneoras 


ARITH 16-Sep-1984 01:10:24 AX-11 Bliss-32 V4.0-74 P 47 
“33t 1e-8eb-1986 41:50:89  PoAsRTL SRETBASSARI GH B82: 29° 10) 
; 1525 1619 1 ROUTINE PARse OUT ¢ ! Put to ether a@ number 
3 1 1611 1 DIGITS, ! where to find the digits 
3 3 1612 1 N, ! Where to find the sign 
3 3 1615 1 EXPONENT, ! Where to find the power of ten 
; : 1818 } , Net ! Where to put the result 
; : = 
; 1531 1olg 1 
3 1 ¢ 1617 1 !44 
5 ; 1913 : : FUNCTIONAL DESCRIPTION: 
3 1535 1620 1! Convert an internal number, which has separate sign, gapenent 
3 3 1621 1! and digit string, into an external number, which combines them 
3 1 16 § 1! in the form ¢nnn.nnn. 
; 1538 16 1! 
3; 1539 1626 1 ! FORMAL PARAMETERS: 
3; 1540 1625 1! 
3 1541 16 $ DIGITS.rnu.dx Where to find the digits 
3 1 rt 16 1! SIGN.rl.r 0 = positive, 1 = negative 
3; 154 1628 1! EXPONENT.wl.r Decimal exponent 
3 ; re} 4 } ARG_DESC.wt.dx Where to put the composite number 
3 3 m4 1631 1°! IMPLICIT INPUTS: 
3; 1546 16 ¢ 1! 
3; 1548 16 i NONE 
3; 1549 16 1! 
3; 1550 16355 1 ! IMPLICIT OUTPUTS: 
; 132) 16 1! 
3 3 25 1637 1! NONE 
3; 155 1638 1! 
3: 1554 1639 1 ! ROUTINE VALUE: 
: 132? 1eey : : COMPLETION CODES: 
: 1389 lose 7! Signals PROLOSSOR for certain ‘impossible’ errors, and MAXMEMEXC 
; 1558 1645 1! if string memory is exhausted. 
: 1223 1644 1! 
: 1560 1645 1 ! SIDE EFFECTS: 
3 1561 1068 1! 
3: 156 1647 1! Biqnels BASS_ILLNUM if there are more than 65,535 digits, 
> 156 1648 1: BASS _MAXMEMERC if space for the string is unobtainable, 
; 1306 1002 : and BAS$_PROLOSSOR if we are unable to free the string. 
3: 1566 1651 1 !-- 
3 1567 1o3¢ 1 
3 1368 16 BEGIN 
3% $ 1654 
: 1570 1655 P 
3 1571 1636 ARG_DESC : REF BLOCK (8, BYTE), 
; 137@ 165 DIGITS : REF BLOCK (8, BYTE); 
3; 157 1028 
3 15746 165 LOCAL 
2 2A nd dmanelpedatigeonrgion GB Te 
: ! 7 1668 ow REF VECTOR (65535, BYTE), Addresses result string 
; LEN, ' Len of inpu 
31 iS 1664 DIGIT BUF : REF VECTOR (65535, BYTE), ! hadtesses input string 
z 1580 1665 HIGH_POS, ' Rox power of ten in result 
3; 1581 1666 LOw_Pos; ! Min power of ten in result 


—o | 


-—_-_-- —_—_—-- -- ee 


10 
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3 
3; 1 
3; 3 
3 1 
3; 1 
3% 
3 % 
3 7 
3 7 
3 7 
3 3 
3% 
3 7 
3 1 
3 3 
3% 
.% 
3 7 
3% 
3% 
3 3 
3; 7 
3; 
3) 
31 
3 Y 
3 1% 
3 
3 3 
3 7 
3% 
3} 
3; 1 
3; 1 
$3 
3 3 
3 % 
3 7 
3; 7 
3% 
3 7 
3 Y 
3; 1 
3} 
3; 7 
3 7 
3; 7 
3 3 
3 Y 
3 
s % 
3} 
3 
3% 
3 7 
3 3 


oan 


—@Dw 


rn) 


'¢ 
Enable a handler to free the local string in case of error. 


NABLE 
FREE_STRINGS (BUF _DESC); 


t+ 

' Allocate enough space to hold the digits, a leading sign, and an 

! imbedded (or trailing) decimal potate We must allocate enough 

; Bpece te reach the units position in order to be able to place 

;_t e decimal point. 

" DIGIT_LEN =. 
1T_BUF i" 


$K_DTYPE_T; 
$K_CLASS_D; 


'¢ 


i If the resultant number has too many digits to be represented on 
: VAX, give an error message. 


SSeS SS SSS ES SSCS See Rae 


o 
on 


3 
N+ Ae 4 


CONAULS WI 


IF ((.HIGH POS = .LOW_POS + 3) GTR 65535) THEN BASSSSTOP (BAS$K_ILLNUM); | 
STRSGET1 DX (ZREF (.HIGH POS - .LOW_POS + 3), BUF_DESC); | 
ee COSCSA_POINTER); 

= VU, 


IF (.SIGN) 
THEN 


ooo 


ee ee a a ea De aed od ed od od dd ed ed 

A a a a 

3 Seee 
OONAWN 

AAA NAA HIE. & BW IAIN III CANON PORINONIPONUNONUPIPUNOPURINONIPUPUPORIFURORUNUROPUNOTD 

owww i=] 
ccccoee 
wn es Do a | ag 
eevee = 
ocv7 
mmmmno ww 
Ounnn @ 
o whee — 
errr ity 
ovvcoz tn 
Nunnne 
Petetetet t= 
S882 "5 
oe Te eno 
p> 
za 
“ 
» 


2 at 


DONOVUVE WN" OVDONOUSWN Oo 


| 
BEGIN 
BUF C.PUTTER] = XC'-'; 
PUTTER = .PUTTER ¢ 1; | 

} 


DECR POS FROM .HIGH_POS TO .LOW_POS DO 
BEGIN 


SANS SSO 
Coooooeo 


WON UE WIN "OO OONOAUSWN—O 


IF (.POS EQL -1) 
THEN 
BEGIN 
BUF C.PUTTER] = %C'.'; 
PUTTER = .PUTTER + 1; 
END; 
IF ((.POS GTR (EXPONENT + .DIGIT_LEN = 1)) OR (.POS LSS .EXPONENT)) 
BUF C.PUTTER] = %C°O" 
BUF C.PUTTER] = .DIGIT_BUF C(.EXPONENT + .DIGIT_LEN - 1) = .POS); 
PUTTER = .PUTTER + 1; 


ee ee 


POPOPOPOPAAAAAAPAAAAAAGCAOSAAOAAA AAS 


SSN 


BUSA 


oN 


pas spade 


50 
FFFFFFFF 8 8©68F 


51 52 
OOOOFFFF  8F 


06 
000000006 0 
04 AE 
000000006 00 
50 


04 B40 


53 


51 


; 1639 1724 END; 

3: 1640 1725 

3 1641 17 § t+ 

3 1906 i 

3 164 1728 

3 1644 1729 

3 1645 1730 ! 

3 1248 1731 ! Free our local string 
3; 164 17 ; t= 

3: 1648 17 STRSFREE1_DX (BUF _DESC); 
3 1649 1734 RETURN; 

3; 1650 1735 ; 


08 
0008 
04 


04 
oc 


oc 


; Now copy the string back to the caller. 
STRSCOPY_R (.ARG_DESC, PUTTER, .BUF); 


BASRTL.SRC 


! end of PARSE_OUT 


007¢ 00000 PARSE_OUT: 
. WORD 
10 ¢2 0000 SUBL2 
AE 7C 0000 CLROQ 
CF 43 00008 MOVAL 
AC g et MOVL 
60 3¢€ 00011 MOVZWL 
AO 00 00014 MOVL 
AC Ci 00018 ADDL3 
50 07 Booie DECL 
39 D1 OOO1F CMPL 
03 18 it 6 BGEQ 
01 CE 00028 MNEGL 
50 00 00028 1$: MOVL 
AC rt B88 3 MOVL 
02 15 000 BLEQ 
50 D4 000 CLRL 
50 DO 00036 2$: MOVL 
AE 84 00039 CLRW 
OE 90 0003¢ MOVB 
02 90 00040 MOVB 
AE bY 00044 CLRL 
56 § 44 984 SUBL3 
Al 00048 MOVAB 
54 Di O004F CMPL 
0B 15 00056 BLEQ 
F OA 8 28 MOVZBL 
1 §B f CALLS 
AE 9F 00065 3$ PUSHAB 
54 D0 00066 OVL 
A F QO06A PUSHAB 
02 F Soap CALLS 
AE D 074 #OVL 
AE D4 00078 CLRL 
AC €9 00078 BLBC 
ahi | ee 
AC cf 87 4$ ADDL3 
Al 3 008C MOVAB 
52 00 00090 MOVL 


o-"*#OOx -~ 2: —-C — @ 


HIGH_POS 
PONENT; RO 


MMDRB—-DOIMNLS-9-Daw 


x 
$ 
RO 

RO, LOW_POS 

BUF _DEST 

#147 BUF_DESC+2 
#2, BUF BESC+3 
BUF _DEST+4 


+ 
Low POS, HIGH_POS, R1 
(RT). R 
Rs, #65535 


ASS$K {EL Wun. -(SP) 
8 f BAS2SS10P 


UF _DES 

R4, 4 (SP) 

4 (SP 

#2, STRSGET1_DX 

BUF _DESC+4, BUF 

PUTTER 

SIGN, 4$ 

#4 @PUTTERCBUF } 
EXPONENT , DIGIT_LEN, R1 
HIGH_POS, POS 


ret O rete reclais 7 


Page 49 


(10) | 


| 
| 


| 
| 


— wm 


N 10 
RIT -Sep- 210: - -0- 
vate ae Te-Sep-198e 81:50:99 EBASRIL SRE SBASsARISH e692; 1 


3 11 00 93 BRB 10$ 
FFFFFFFF © 8F i if 93 5$: cMPL POS, #1 
04 BE4O — 9 H MOVB #46, @PUTTERCBUF 
04 AE D6 OOOA INCL U 
52 59 04 AE Ci O00A6 6$: ADDL3 PUTTER, BUF, R2 
51 D1 OO00AB CMPL POS, RS 
06 14 OOAE BGTR 
oc ' AC 1 01 0 B CMPL = POS, EXPONENT 
03 18 0B4 BGEO 
62 0 9 0086 7$: MOVB #48, (R2) 
p i 00B BRB 
54 53 1 § 00BB 8$ SUBL3 POS, R3, R4 
62 6445 90 000BF MOVE (R4SCDIGIT_BUFI, (R2) 
04 AE D6 000C3 9$ INCL PUTTER 
31 D 900¢6 DECL POS 
56 1 D1 000C8 10$:  CMPL POS, LOW_POS 
C8 18 000CB BGEO }43=s«S$ 
50 DD 000CD PUSHL BUF 
08 AE 9F OO0CE PUSHAB PUTTER 
10 AC OD 90002 PUSHL  ARG_DESC 
000000006 00 03 FB 9000 CALLS #3, STRSCOPY_R 
08 AE 9F 000DC PUSHAB BUF _ 
000000006 00 01 FB O00DF CALLS #1,~STRSFREE1_DXx 
04 OEG RET 
0000 O00E7 11$: -WORD Save nothing 
50 08 Ac DO OO0E9 MOVL  8(AP), RO 
50 04 AO DO OO0ED MOVL  4(RO). RO 
F8 AO 99F OOOF1 PUSHAB BUF _DESC 
01 DD O00F4 PUSHL #1 
5E DD 0006 PUSHL SP 
7E 04 AC 7D 000F8 MOVQ. 4(AP), - 
0000v CF 03 FB OO0FC CALLS #3, FREE STRINGS 
04 00101 RET 


; Routine Size: 258 bytes, Routine Base: _BASS$CODE + OBSF 


—— sss —— — 


-o | 


Pe Se Se Se Ge Se Se Se He Ge Se Be Se Be Se Ge Be Be Se Se Be Ge Se Be Se Fe Se Se Se Bs Se Se Be Se 


on 


11 
BASSS 18-Sep-1984 91:10:68 rest Bliss-32 V4.0-74 Page 51. 
1-024 14-Sep-1984 11:56:59 BASRTL.SRCJBASSARITH.B852;1 (11) 
; 16 ¢ 17 § 1 ROUTINE FREE_STRINGS ( ! Free local strings 
3; 16 17 1 $1G, ! Signal vector 
; 1920 17 3 1 MECH, ! Mechanism vector 
; 1655 17 1 ENBL ! Enable vector 
3 1628 1740 1 d= 
3; 16 1741 1 
; 1658 1006 1 !+4 
; 1659 1745 1 ! FUNCTIONAL DESCRIPTION: 
3; 1660 1744 1! 
; 1661 1745 1! If we are unwinding, free the local strings. They are passed 
; 1666 1708 7 | in the enable vector. 
3: 166 1747 11! 
3 1664 1748 1 ! FORMAL PARAMETERS: 
3; 1665 1749 1! 
3 1666 1750 1! $1G.rl.a A counted vector of parameters to LIBSSIGNAL/STOP 
3; 1667 1751 1! MECH. rl.a A counted vector of info from CHF 
3 1en8 1726 ' ENBL.ra.a A counted vector of ENABLE argument addresses. 
: 1670 1754 1 ' IMPLICIT INPUTS: 
3; 1671 1755 1! 
: 4 24 1756 1! NONE 
; 167 1757 1! 
3: 1676 1758 1 ! IMPLICIT OUTPUTS: 
3; 1675 1759 1! 
3; 1676 1760 1! NONE 
3; 1677 1761 1! 
; 1678 1796 1 ! ROUTINE VALUE: 
3 1679 1763 1 ! COMPLETION CODES: 
3; 1680 1764 1! 
3: 1681 1765 1! Always SSS_RESIGNAL, which is ignored when unwinding. 
3 io 1766 1! 
3; 168 1767 1°! SIDE EFFECTS: 
> 1684 1768 1! 
3; 1685 1769 1! Frees all of the strings passed as enable arguments. 
3; 1686 1770 1! 
3 1687 1771 1 !-- 
; 1688 1772 1 
3; 1689 177% 2 BEGIN 
3; 1690 1775 2 
3; 1691 1775 3 MAP 
3 1on6 1776 SIG : REF VECTOR, 
3 169 1777 MECH : REF VECTOR, 
3 1694 1778 ENBL : REF VECTOR; 
3; 1695 1779 
3: 1696 1780 '¢ 
3; 1697 1781 ! Only free the strings if this is the UNWIND condition. 
: 1899 1788 5° 
: 1700 1784 IF ( NOT (LIBSMATCH_COND (SIG C1], ZREF (SS$_UNWIND)))) THEN RETURN (SS$_RESIGNAL); 
1B By 
; 170 1787 ! Go through the enable arguments, freeing them. 
3: 1704 1788 !e 
3; 1705 1789 
3 1708 19 INCR ARG_NO FROM 1 TO .ENBL (0) DO 
3 1708 1792 IF (,.ENBL C.ARG_NO) NEQ 0) THEN STRSFREE1_DX (.ENBL C.ARG_NO)); 


a 
ee ee Pe Se Se Se Ge Ge Se Ge Se Se Se Se se Se Se Fe Sees Se See Se Se Se Se Se sete Seas 


| BASSSARITH 
het 
: 1398 1332 ; RETURN (SS$_RESIGNAL) 
: 1711 1795 END; 5: nt 
7E 0920 
7E 06 ac 
000000006 00 
1B 
50 Oc BC 
000000006 00 
E9 52 0c 
50 0918 
; Routine Size: 57 bytes, Routine Base: _BASS$COD 
: 1712 1796 1 END 
: 171 1797 
: 1714 1798 0 ELUDOM 
; PSECT SUMMARY 
3 Name Bytes 
> _BASSCODE 3226 NOVEC,NOWR 
; Library Statistics 
; File Total 
: _$255$DUA28:(SYSLIBISTARLET.L32;1 9776 


11 
1b-Se -1984 01:10:24 AX-11 Bliss-32 V4.0-74 
1a-sep-19 4 94:48:68 BASRTL. REIBASSARI GH 68251 


end of FREE_STRINGS 


0004 00000 FREE_STRINGS: 
~ WORD Sa § 
BE 3¢ 00002 HOVZUL #2336, <(SP) 
—E DD 9900 PUSHL SP 
04 C1 00009 ADDL3 #4, SIG, =(SP) 
08 FB 00008 CALLS #2, L 1BSMATCH_COND 
50 €9 0001 BLBC = RO. 38 
52 D4 00018 CLRL = ARG_NO 
12 11 OOO1A BRB 
42 00 0001C 1$ MOVL § @ENBLCARG_NOJ, RO 
60 05 00021 TSTL (ROD 
09 13 00023 BEQL 2$ 
50 DD 00025 PUSHL RO 
01 Fe 00027 CALLS #1, STRSFREE1_Dx 
BC F 000¢E 28: AOBLEQ @ENBL, ARG_NO; 1$ 
F 3C 00033 3$: MOVZWL #2328. RO 
04 00038 RET 
E + 0C61 


Attributes 
1, Ws. EE, GR, 


10 0 


end of module BASSSARITH 


LCL, REL, CON, PIC,ALIGN(2) 


Pages Processing 
Mapped Time 
581 00:01.0 


—@w 


D111 
19=300- 138% 1:10:66 Ax-11 Bliss-32 V Page 53 
14-Sep-1984 11:56:59 BASRTL.SRC BASSMRI TH. 5 2:1 dad 


— 


Used: 188 pages 
Compilation Complete 


: COMMAND QUALIFIERS ; 
H parenteral tear haath einai tenia icentanatt he MSRC$:BASSARI TH/UPDATE=(ENH$:BASSARITH F 
3 1715 1799 0 : 
3; Size: 2713 cope + 513 data bytes $ 
° Run Time: 00:4 | 

: Elapsed he 01:27.1 

; Lines/CPU Min: $388 

3 Lexemes/CPU-Min: 12779 


003 AH-BT13A-SE 
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